連接地址行 - 優化和最佳實踐

Question

我寫了下面的代碼來查看地址列表。在地址線1（Add1）本身就是建築物號碼的情況下，它與地址線2（Add2）連接。例如：

ADD1 「10」，ADD2 「貝克街」

變爲：

ADD1 「10貝克街」，ADD2 「」

Sub concatenateAddressLines() 

Application.ScreenUpdating = False 

    Dim lastRowNumber As Long 
    lastRowNumber = ActiveSheet.UsedRange.Rows.Count 
    Dim currentRowNumber As Long 
    currentRowNumber = 0 

    Range("1:1").Find("Add1").Select 
    ActiveCell.Offset(RowOffset:=1).Activate 

Do Until currentRowNumber = lastRowNumber - 1 


    If IsNumeric(ActiveCell.Value) Then 
     ActiveCell.Value = ActiveCell.Value & " " & ActiveCell.Offset(0, 1).Value 
     ActiveCell.Offset(0, 1).Value = "" 
     ActiveCell.Offset(RowOffset:=1).Activate 
     currentRowNumber = currentRowNumber + 1 
    Else 
     ActiveCell.Offset(RowOffset:=1).Activate 
     currentRowNumber = currentRowNumber + 1 
    End If 

Loop 

End Sub 

（地址第一行總是被命名爲Add1，但每個文件的實際列都在變化。）

我是新來的VBA，但我知道，我應該使用選擇和激活來避免。如果任何人都可以給我一些關於如何在最佳實踐和/或優化方面改進這些代碼的建議，我們將非常感激。

Answer 1

我注意到的第一件事情是，在末尾有Application.ScreenUpdating = False而沒有Application.ScreenUpdating = True，這被認爲是不好的做法。

但是，您覺得有必要放入Application.ScreenUpdating = False這一事實暗示了一個很大的優化可能性。

它會（幾乎）以vba而不是excel進行處理的速度會更快。在這種情況下，這意味着將兩列讀入vba數組，以相同的方式操縱它，並將它們讀回excel。

Activesheet.UsedRange在更新自身時也略有鬆懈，所以您可能需要使用Cells(Rows.Count, 1).End(xlUp).Row的行代替。

例如，這應該是您的代碼的一個更快的版本：用於陣列

Option Explicit 

Sub concatenateAddressLines() 
    Dim firstUsedColumnNumber As Long 
    firstUsedColumnNumber = ThisWorkbook.ActiveSheet.Range("1:1").Find("Add1").Column 
    Dim lastRowNumber As Long 
    lastRowNumber = Cells(Rows.Count, firstUsedColumnNumber).End(xlUp).Row 
    Dim inputRange As Range 
    Set inputRange = Range(Cells(2, firstUsedColumnNumber), Cells(lastRowNumber, firstUsedColumnNumber + 1)) 
    Dim data() As Variant 
    data = inputRange 
    Dim i As Long 
    For i = LBound(data) To UBound(data) 
     If IsNumeric(data(i, 1)) Then 
      data(i, 1) = data(i, 1) & " " & data(i, 2) 
      data(i, 2) = "" 
     End If 
    Next i 
    inputRange.Value = data 
End Sub 

Answer 2

使用bobajobs建議（因爲它是更快）：

Public Sub ConcatenateAddressLines() 

    Dim rAdd1 As Range 
    Dim lLastRow As Long 
    Dim vValues As Variant 
    Dim lCounter As Long 

    'Identify the sheet you're using. All ranges/cells that start with . will reference this sheet. 
    'Google "With End With VBA" 
    With ThisWorkbook.Worksheets("Sheet1") 
     'Find remembers the last settings used, so best to be specific. 
     Set rAdd1 = .Range("1:1").Find(What:="Add1", _ 
             After:=.Range("A1"), _ 
             LookIn:=xlValues, _ 
             SearchDirection:=xlNext) 
     'Only continue if Add1 is found. 
     'An error occurs if you add .Column to the end of the FIND statement 
     'and nothing is found. 
     If Not rAdd1 Is Nothing Then 
      'Find the last row in the Add1 column. 
      lLastRow = .Cells(Rows.Count, rAdd1.Column).End(xlUp).Row 
      If lLastRow > 1 Then 
       'Put the range values into an array. 
       vValues = .Range(.Cells(2, rAdd1.Column), .Cells(lLastRow, rAdd1.Column + 1)) 

       'Loop through the array and place numeric values and streets in first dimension. 
       For lCounter = LBound(vValues) To UBound(vValues) 
        If IsNumeric(vValues(lCounter, 1)) Then 
         vValues(lCounter, 1) = vValues(lCounter, 1) & " " & vValues(lCounter, 2) 
        End If 
       Next lCounter 

       'Place the values back on the worksheet. 
       rAdd1.Offset(1).Resize(UBound(vValues, 1), UBound(vValues, 2)).Value = vValues 
      End If 
     End If 
    End With 
End Sub 

Answer 3

另一種替代方法是使用自動篩選來查找數字行然後枚舉這些行。這應該比用IsNumeric（）檢查每一行更快（

Sub ConcatenateAddress() 
    On Error GoTo ExitSub 
    Application.ScreenUpdating = False 

    Dim wsSrc As Worksheet: Set wsSrc = ActiveSheet 
    Dim Add1 As Range: Set Add1 = wsSrc.UsedRange.Find("Add1", , xlValues, xlWhole) 

    If Not Add1 Is Nothing Then 
     Dim Col1 As Long: Col1 = Add1.Column 
     Dim LastRow As Long: LastRow = wsSrc.Columns(Col1).Find("*", SearchDirection:=xlPrevious).Row 
     Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 

     Range(Add1, Cells(LastRow, LastCol)).AutoFilter Field:=1, Criteria1:=">0", Operator:=xlAnd 
     With Range(Cells(Add1.Row + 1, Add1.Column), Cells(LastRow, LastCol)) 
      For Each Rw In .SpecialCells(xlCellTypeVisible).Rows 
       Cells(Rw.Row, Col1) = Cells(Rw.Row, Col1) & " " & Cells(Rw.Row, Col1 + 1) 
       Cells(Rw.Row, Col1 + 1) = "" 
      Next Rw 
     End With 
     Range(Add1, Cells(LastRow, LastCol)).AutoFilter 
    End If 

ExitSub: 
    Application.ScreenUpdating = True 
End Sub