使用一個2dim數組而不是兩個1dim數組在工作maco

我正在搜索一個空白單元格的列，如果我找到一個然後我想複製兩個前面的單元格與空白單元格相鄰併發布到新工作表。使用一個2dim數組而不是兩個1dim數組在工作maco

blksArray是我正在搜索空白的列。

emailArray和nameArray是相鄰列複製細胞如果空白blksArray

宏的作品被發現，但我希望我可以用一個單一的陣列代替兩個數組emailArray和nameArray

謝謝

編輯：對不起，如果我是混淆源工作表：

Name Emails   XXX 
Bill [email protected]  abc  
Tony [email protected] 
Roger [email protected] aaa 
Diane [email protected] bbb 
Pam  [email protected] 
Barb [email protected] 
Ziggy [email protected] ddd

鉭rget表：

Name Emails   XXX 
Tony [email protected] 
Pam  [email protected] 
Barb [email protected]

代碼：

Sub MoveCellsIfEmpty() 
Dim blankArray As Variant, textArray As Variant 
Dim wsS As Worksheet 
Dim wsT As Worksheet 
Dim LR As Long 
Dim i As Long 

Set wsS = ThisWorkbook.Sheets("NodeFile") 
Set wsT = ThisWorkbook.Sheets("Blanks") 

With wsS 
    LR = .Range("A" & .Rows.Count).End(xlUp).Row 

    '\\ search column 
    blksArray = .Range("E2:E" & LR).Value 

    '\\ Cells to copy 
    emailArray = .Range("D2:D" & LR).Value 
    nameArray = .Range("C2:C" & LR).Value 

     For i = LBound(blksArray, 1) To UBound(blksArray, 1) 
      If IsEmpty(blksArray(i, 1)) Then 
       emailArray(i, 1) = emailArray(i, 1) 
       nameArray(i, 1) = nameArray(i, 1) 
      Else 
       emailArray(i, 1) = "" 
       nameArray(i, 1) = "" 
      End If 
     Next i 
End With 

'\\ Post back to target sheet 
With wsT 
    .Range("A2:A" & LR).Value = nameArray 
    .Range("B2:B" & LR).Value = emailArray 
End With 

End Sub

來源

2014-11-03 xyz

好吧，我用一個陣列重做我的答案。當你將一個範圍讀入一個數組時，它會創建一個電子表格座標的二維數組（而且知道！），而不是創建多個數組並將它們修剪或重新添加到一個新數組中，我只是創建瞭如果第三個值爲空白，則通過將它們添加到新工作表進行循環。我在104,000條記錄上運行了它，花了3到4秒。希望這是更多的錢你爲什麼:)

Sub MoveCellsIfEmpty() 
Dim blankArray() As Variant 
Dim wsS As Worksheet 
Dim wsT As Worksheet 
Dim LR As Long 
Dim i As Long 
Dim j As Long 

Set wsS = ThisWorkbook.Sheets("NodeFile") 
Set wsT = ThisWorkbook.Sheets("Blanks") 

With wsS 
    LR = (.Range("A" & .Rows.Count).End(xlUp).Row) 
    blankArray = .Range("A2:C" & LR) 
End With 

j = 1 
For i = 1 To LR - 1 
    If blankArray(i, 3) = "" Then 'if blank paste to new sheet 
     wsT.Range("A" & j).Value = blankArray(i, 1) 
     wsT.Range("B" & j).Value = blankArray(i, 2) 
     j = j + 1 
    End If 


Next 


End Sub

來源

2014-11-03 19:05:26 Tbaker

你好Tbizzess謝謝你的迴應，我'編輯'我的問題，使其更清楚（對此感到遺憾）。我使用的是數組，因爲數據集很大，而且我重新使用了一個我已經擁有的宏，這似乎很好。 – xyz 2014-11-03 19:18:43

哇感謝代碼和文本都同樣有幫助 – xyz 2014-11-03 23:07:43

使用一個2dim數組而不是兩個1dim數組在工作maco

回答

相關問題