使用一个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

回答

相关问题