數組範圍和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