数组范围和IsEmpty如果然后声明VBA。覆盖所有内容而不是有选择地插入

Question

我是VBA的全新产品。到目前为止，我的腰带已经有4个星期了。这是完成报告数据清理和分析的宏列表的最后一部分。也许这不是最好的办法吗？我仍然对此感到陌生，所以我愿意接受其他建议。但它需要是一个宏观。这基本上是什么样子（突出显示的字段中填充VLOOKUP，这就是为什么我有两个不同的阵列，因为他们不是连续的）：

link to snip of the worksheet

的行数取决于变化报告。有时它的4000行，有时更多，有时更少。但是我确信每一列都是一样的。我们试图尽可能地自动化，以便我们能够让一些技术含量较低的人员能够贯穿整个过程。我第一次经历这个过程花了6个小时（尽管我也是在记笔记）。对于这里的高级人员来说，每个人需要大约2小时，具体情况取决于。在年底之前，我们有大约300个这样的领域。

无论如何，这段代码可以工作，但它会覆盖我插入的所有iferror/vlookup结果。我猜我的'For If 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