Excel VBA 非连续单元格复制问题 初学VBA,想拷贝Range("B2:E2,H2:I2"),结果却是B2:I2,求解。

Question

Sub 不打开文件读取数据()

Dim MyFile As String, WJM As String, GZBM As String
Dim XLapp As New Excel.Application
Dim Xlbook As Excel.Workbook
Dim selectpart As String
selectpart = "B2:E2,H2:I2"
Application.DisplayAlerts = False

Application.ScreenUpdating = False
WJM = "数据"

GZBM = "Sheet1"
MyFile = "D:\My Documents\" & WJM & ".xlsx"
Set Xlbook = XLapp.Workbooks.Open(MyFile)
XLapp.Visible = False

With Xlbook.Sheets(GZBM)

.Range(selectpart).Copy
End With

Xlbook.Saved = True
Xlbook.Close
Set XLapp = Nothing
Set Xlbook = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

对于不连续区域的复制，必须符合几个条件：
1是不同区域之间必须行对应或列对应，你的这个区域是行对应，符合条件。
2、必须在文件关闭之前进行贴粘，一旦关闭文件之后，剪贴板里的内容就失去连接，系统将自动将内容转为通用格式，从而导致复制整个B2:I2。
所以，如果复制的是多重区域，建议分步执行。

追问

此代码存放在Personal.xlsb文件里。按F8运行到End With，转到Personal的Sheet1，按Ctl+V，粘贴出来的是B2:I2的数据。此代码是参考网友的代码写成。原来用的代码是在打开源文件的状态下拷贝Range("B2:E2,H2:I2")没有问题。

追答

虽然原程序没有关闭，但是你的粘贴操作没有在你所开的新的实例里操作（Dim XLapp As New Excel.Application），而是在当前的实例里操作的。所以，仍然是跨了进程，剪贴板仍然需要把COPY的源内容变成通用格式，所以会全部拷贝。
如果一定要实际两个区域的拷贝，必须拷贝和粘贴在同一EXCEL APPLICATION实例里面进行。
要保证这一点，有两种可选的方法：
第一种方法是，在关闭Xlbook之前，用你新开的不可见的Xlapp再打开一个Workbook，然后粘贴进去。
另一种方法，就是用现在的EXCEL APPLICATION来开 MyFile （ "D:\My Documents\" & WJM & ".xlsx"）文件。即把Dim XLapp As New Excel.Application改为Set XLapp = Excel.Application，然后在关闭该文件之前进行粘贴，就应该没问题了。但这样就无法用XLapp.Visible = False了，它会把你现在打开的EXCEL.APPLICATION隐藏（包括当前里面打开的所有WORKBOOK），退而求其次的方法是用 Xlbook.Worksheets.Visible=False，不过在关闭之前要把visible改回来，否则下次你下EXCEL手工打开时也会看不到表格。

如果，你即不想在现在的EXCEL.APPLICATION实例中打开MyFile，又不想在新开的EXCEL.APPLICATION中打开目标文件进行粘贴，也就是你希望跨实例进行复制粘贴不连续区域的话，那就不能用这个方法进行操作了，一个方法是根本不用剪贴板，可以考虑用远程引用取数，如果不想保留远程引用，那么可以把远程引用作为中间结果，再把引用结果转变为本地结果。
比如，还是想把当前工作薄同一路径下的src.xls文件中的"Sheet1"表格里的"B2:E2,H2:I2"复制到当前工作薄的Sheet1表格的A1:F1中，那么可以用：
Sub GetRemoteData()
Dim DataSrc$, tgtCell As Range
Set tgtCell = Application.ActiveCell '粘贴位置为当前焦点单元格
DataSrc = "='" & ThisWorkbook.Path & "\[src.xls]Sheet1'!"
'取数
tgtCell.Range("A1") = DataSrc & "B2"
tgtCell.Range("A1").AutoFill tgtCell.Range("A1:D1")
tgtCell.Range("E1") = DataSrc & "H2"
tgtCell.Range("E1").AutoFill tgtCell.Range("E1:F1")
'把远程连接改成本地结果
tgtCell.Range("A1:E1") = tgtCell.Range("A1:E1").Value
End Sub

追问

程序经修改后读写速度大幅提高，已经可以自动定位到指定位置,惟有数据不能保持原有格式，源文件数据的百分比显示为四舍五入的小数，有失准确。将tgtCell.Range("E1").AutoFill tgtCell.Range("E1:F1")语句加上, Type:=xlFillCopy
将tgtCell.Range("A1:E1") = tgtCell.Range("A1:E1")语句改写两边加.Value,或.Formula或.FormulaR1C1均无济于事,有何高见?

追答

远程引用进只能读取数值，不读取格式，因此远程引用耗用的资源较少。

远程引用是不会四舍五入的，之所以显示为四舍五入的格式，是因为使用AutoFill时，自动把本工作薄目标位置起始单元格格式带到后面填充的单元格。因此如果你所取区域数据格式不是同一种格式，就不要用AutoFill，可以改为如下。

 

Sub GetRemoteData()
Dim DataSrc$, tgtCell As Range
Set tgtCell = Application.ActiveCell '粘贴位置为当前焦点单元格
DataSrc = "='" & ThisWorkbook.Path & "\[src.xls]Sheet1'!"
'取数
For Each c In Range("B2:E2,H2:I2")
i = i + 1
tgtCell.Cells(1, i) = DataSrc & c.Address
Next
'把远程连接改成本地结果
tgtCell.Range(Cells(1, 1), Cells(1, i)).Value = tgtCell.Range(Cells(1, 1), Cells(1, i)).Value
End Sub

 

至于目标区域的格式，可以直接在程序中设置，也可以在建立工作表时提前设好，程序只传输数据。

比如：假如你是要把多个工作薄的远程数据放在固定的列，你的程序只是不断地增加记录行，那么你完全可以把目标表格对应的列在一开始都设好，比如A列是数值、B列是百分数等等，程序中只传递数值会大大减少资源的消耗。

 

另外，如果你是要把复制多个表格对应的数据到当前表格的不同行的话，最后一句建议一次性执行，而不要每复制一个数据就修改一次，比如你已经从n个工作薄复制了数据到当前工作薄中以stCell为起始单元格的Range中，那么在执行完所有数据引用后，直接执行下句一次就可以了：

stCell.Range(Cells(1, 1), Cells(n, 6)).Value = stCell.Range(Cells(1, 1), Cells(n, 6)).Value

 

当然如果目标位置具有不确定性，因为远程引用无法获取源的格式的。所以，如果你的在程序设计时已经知道源的格式，那么只能一个个在程序中进行设置了，比如要设目标位置的第一单元格为精确到2位的数值格式，第二单元格为精确到2位百分比，那么，你在做完远程引用数据转本地数据后再设置一下格式：

tgtCell.Range("A1").NumberFormat = "#,##0.00"
tgtCell.Range("B1").NumberFormat = "0.00%"

Answer 2

代码本身似乎没有问题。
对于非连续单元格，可以复制，但在粘贴时，不会按照原来的非连续布局粘贴，而是会粘贴为一个连续区域。因此，还是建议分段复制粘贴更为合适。

追问

采用不打开源文件读取数据的方法没有用过。参考有关资料，在不打开源文件状态下读取数据的方法至少有五种。源文件数据是网页数据表每日更新的。目标文件是择取源文件的("B2:E2,H2:I2")的数据，然后复制到目标文件的Range(Cells(x,4:Cells(x,9)。目标文件的Range的单元格(x,4:x,9)之所以是x，是因为源文件与目标文件的日期排序不同。

Answer 3

看起来是没问题，测试也没问题，你按F8单步来运行看看复制的区域是不是正确。

追问

我采用For each rng In Range("A:A")，If rng.value = dtDate[注:dtDate=Date]来定位目标文件当日日期列的单元格地址。源文件与目标文件分两组共100多个工作薄。原来采用同时打开所有的工作薄逐个的更新目标文件的数据。很慢。对VBA我是个门外汉。虽然参考了许多有关资料，还写不出更理想的代码。敬请对VBA知识甚多的朋友襄助。

追答

把表发我看看，说明你需要的最终效果，是最终效果！ 看看能不能有更好的办法解决。

987122817@qq.com

追问

表已经发出。请查阅。