PasteSpecial 两次崩溃 Excel VBA

Question

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

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

调试后，这是我到目前为止所学到的： *第一个 .PasteSpecial 始终有效，但当它到达第二个 .PasteSpecial 时，它总是失败。 *我在第一个 .PasteSpecial 之后尝试了 STOP，然后单步执行代码，在我单步执行第二个.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

您的问题是当您实际上不需要粘贴任何内容时，您正在提交 CPU 来执行操作系统级别的任务。

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

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

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

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

编辑：

下面是一个比我最初找到的解决方案更可靠的更好答案。这是对 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