PasteSpecial 两次崩溃 Excel VBA

Question

我一直在寻找在 excel vba 宏中多次使用 .PasteSpecial 的解决方案。我的报告有时可能有数千行。在这些报告中有两列，我需要合并这些列，以便如果一列有空白，我需要第二列的值；否则，只保留第一列中的值。我需要在两个不同的地方应用两次。这都藏在一个更大的代码中。

我的解决方案是将 .PasteSpecial 与“跳过空白”一起使用。 excel 处理速度很快，比逐行循环快得多。问题是代码不断崩溃 excel.

调试后，这是我到目前为止学到的东西： *第一个 .PasteSpecial 总是有效，但是当它到达第二个 .PasteSpecial 时它总是失败。 *我在第一个 .PasteSpecial 之后尝试了 STOP 然后单步执行代码，在我单步执行 second.PasteSpecial 之后代码工作正常。 *如果我单步执行第二个 .PasteSpecial 它就像没有任何问题一样工作 - 但如果我只是运行代码像正常一样崩溃。 *我在代码中调换了两个 .PasteSpecials 的顺序。当我这样做时，它不再在有问题的 .PasteSpecial 上崩溃，但它确实在最初工作的 .PasteSpecial 上崩溃。

基于此，我知道问题是 Excel 不喜欢在代码中两次使用 .PasteSpecial。仍然找不到解决方法。我试过清空剪贴板，但我不太了解如何设置数组，更不用说对这么多数据是否有效了。有人知道解决方案或解决方法吗？

这是我的 .PasteSpecial 代码：

MainSheet.Range("N:N").Copy
MainSheet.Range("P:P").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

MainSheet.Range("R:R").Copy
MainSheet.Range("Q:Q").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Answer 1

编辑：

下面是一个比我最初找到的解决方案更可靠的更好答案。这是对 FaneDuru 的回答中的一些建议的改编。这种解决方案对资源的负担更大；但是，就目前而言 - 它可靠地执行任务（不会崩溃）。我希望有比行循环更好的答案；但是，这确实回答了我的 OP。感谢大家的帮助！

    Sub copyColumnsArray()
 Dim lastR As Long, arrCopy
 
 lastR = MainSheet.Range("N" & rows.count).End(xlUp).row
 arrCopy = MainSheet.Range("N1:N" & lastR).value 

Dim ArrayIndex as Variant
Dim RowCount as String
RowCount = 1

For Each ArrayIndex in arrCopy
  If ArrayIndex = "" then
    RowCount = RowCount +1
    'Skip Blank
   else
    MainSheet.Range("P"+RowCount).value = ArrayIndex
    RowCount = RowCount + 1
   end if
 Next
 

 lastR = MainSheet.Range("R" & rows.count).End(xlUp).row
 arrCopy = MainSheet.Range("R1:R" & lastR).value

RowCount = 1

For Each ArrayIndex in arrCopy
  If ArrayIndex = "" then
    RowCount = RowCount +1
    'Skip Blank
   else
    MainSheet.Range("Q"+RowCount).value = ArrayIndex
    RowCount = RowCount + 1
   end if
 Next

End Sub

Answer 2

不需要格式化，请测试下一段代码。它使用数组，不使用剪贴板并且速度更快。如果两个填充列中的行之间不需要存在对应关系，则可以使用下一个快速方法：

Sub copyColumnsArray()
 Dim lastR As Long, arrCopy, arrFin, i As Long, k As Long
 
 lastR = MainSheet.Range("N" & rows.count).End(xlUp).row
 arr = MainSheet.Range("N1:N" & lastR).value
 
 'fill another array only with non empty values:__________________
 ReDim arrFin(UBound(arr) To 1): k = 1
 For i = 1 To UBound(arrCopy)
    If arrCopy(i, 1) <> "" Then arrFin(k, 1) = arrCopy(i, 1): k = k + 1
 Next i
 ReDim Preserve arrFin(k - 1 To 1)
 '______________________________________________________
 
 MainSheet.Range("P1").Resize(UBound(arrFin), 1).value = arrFin
 
 lastR = MainSheet.Range("R" & rows.count).End(xlUp).row
 arr = MainSheet.Range("R1:R" & lastR).value
 
 'fill another array only with non empty values:__________________
 ReDim arrFin(UBound(arr) To 1): k = 1
 For i = 1 To UBound(arrCopy)
    If arrCopy(i, 1) <> "" Then arrFin(k, 1) = arrCopy(i, 1): k = k + 1
 Next i
 ReDim Preserve arrFin(k - 1 To 1)
 '______________________________________________________
 
 MainSheet.Range("Q1").Resize(UBound(arrFin), 1).value = arrFin
End Sub

Answer 3

您的问题是，您实际上并不需要粘贴任何内容，但您却在承诺 CPU 执行 OS 级别的任务。

单元格具有值...所以使它们相等，它们...将...成为...

Range("C1").Value = Range("A1").Value

或者，您可以使用幂查询来执行此操作，其中 Table 2 Col2 为空且 ID = ID

PasteSpecial 两次崩溃 Excel VBA

PasteSpecial twice crashes Excel VBA

excel

vba

crash

copy

copy-paste