数组范围和IsEmpty If Then语句VBA.覆盖所有内容，而不是选择性插入

Question

我是VBA的新手。到目前为止，我已经有大约4周的时间了。这是一长串宏的最后一部分，用于完成报表的数据清理和分析。也许这不是最好的方法？我还不熟悉这个，所以我对其他建议持开放态度。但它必须是宏观的。这基本上就是它的样子(突出显示的字段用vlookup填充，这就是为什么我有两个不同的数组，因为它们不连续)：

链接到工作表的剪切

行数因报表而异。有时它有4000行，有时更多，有时更少。但我已经确保每一列都是一样的。我们正试图尽可能多地实现自动化，这样我们就可以让一些技术含量较低的人来完成整个过程。我第一次经历这个过程花了我6个小时(尽管我也在做笔记)。对于这里的老年人来说，每一个大约需要2个小时，具体取决于情况。在年底之前，我们有大约300件这样的事情要做。

无论如何，这段代码是有效的，但它覆盖了我插入的所有iferor/vlookup结果。我猜这应该归咎于我的"For Each If Then"的说法。但我已经为此工作了几天，尝试了不同的方法来实现这个目标，这是我最接近的一次。如有任何帮助，我们将不胜感激。我相信这是一件非常简单的事情。。。

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
Call OptimizeCode_Begin
lastRow = Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)
Set rng11 = ActiveSheet.Range("BL2:BV2" & ":BL" & lastRow)
Set sourcerng = ActiveSheet.Range("BE2:BF2" & ":BE" & lastRow)
arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
For Each cell In sourcerng
If IsEmpty(cell) Then
rng3.Value = arr3
rng11.Value = arr11
End If
Next
Call OptimizeCode_End
End Sub

Answer 1

您指的是整个范围：

rng3.Value = arr3

因此，当任何一个都为空时，就会设置整个范围，而不仅仅是那一行。我们可以使用Intersect来完成这一行

Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3

此外，你的范围在错误

Set rng3 = ActiveSheet.Range("BH2:BJ2" & ":BH" & lastRow)

将指范围BH2:BJ2:BH100

Cahnge至：

Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)

所以：

Sub AutomateAllTheThings6()
Dim arr3() As String
Dim arr11() As String
Dim rng3 As Range
Dim rng11 As Range
Dim sourcerng As Range
Dim lastRow As Long
Call OptimizeCode_Begin
lastRow = ActiveSheet.Range("D1").End(xlDown).Row
Set rng3 = ActiveSheet.Range("BH2:BJ" & lastRow)
Set rng11 = ActiveSheet.Range("BL2:BV" & lastRow)
Set sourcerng = ActiveSheet.Range("BE2:BF" & lastRow)
arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
For Each cell In sourcerng
If IsEmpty(cell) Then
Intersect(rng3, ActiveSheet.Rows(cell.Row)).Value = arr3
Intersect(rng11, ActiveSheet.Rows(cell.Row)).Value = arr11
End If
Next
Call OptimizeCode_End
End Sub

Answer 2

您也可以将这样的版本与数组一起使用。尽管在我的代码中，结果没有粘贴到数组中，但计算是基于它们完成的，这使得代码执行速度比在范围内的单元格上操作时快得多。

Option Explicit
Option Base 1
Sub AutomateAllTheThings6()
Dim arr3() As String, arr11() As String
Dim rng3 As Range, rng11 As Range, sourceRng As Range
Dim vSource As Variant
Dim nCounter1 As Long, nCounter2 As Long, lastRow As Long
Call OptimizeCode_Begin
Const firstRow As Long = 2
With ActiveSheet
lastRow = .Range("D1:D" & Range("D1").End(xlDown).Row).Rows.Count
Set rng3 = .Range("BH" & firstRow & ":BJ" & lastRow)
Set rng11 = .Range("BL" & firstRow & ":BV" & lastRow)
Set sourceRng = .Range("BE" & firstRow & ":BF" & lastRow)
End With
vSource = sourceRng
arr3() = Split("UNKNOWN,UNKNOWN,UNKNOWN", ",")
arr11() = Split("UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, UNKNOWN, 00/00/0000, 00/00/0000, 00/00/0000, 00/00/0000, NEEDS REVIEW", ",")
For nCounter1 = LBound(vSource) To UBound(vSource) 'loop through all rows in source range
For nCounter2 = LBound(vSource, 2) To UBound(vSource, 2) 'loop through all columns in the row
If IsEmpty(vSource(nCounter1, nCounter2)) Then 'if cell is empty
rng3.Rows(nCounter1) = arr3
rng11.Rows(nCounter1) = arr11
Exit For
End If
Next nCounter2
Next nCounter1
Call OptimizeCode_End
End Sub