アドレス行を連結する - 最適化とベストプラクティス

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 

（アドレス行1の名前は常にAdd1ですが、実際の列はファイルごとに変更されています）

私はVBAに新しいですが、私は選択とアクティブを使用して回避する必要があることを承知しています。ベストプラクティスや最適化の面でこのコードを改善する方法について、誰かから助言をいただければ幸いです。

Answer 1

私が最初に気づくのは、最後にApplication.ScreenUpdating = TrueがないApplication.ScreenUpdating = Falseがないことです。これは悪い習慣とみなされます。

しかし、Application.ScreenUpdating = Falseを入れておく必要があると感じたという事実は、大きな最適化の可能性を示唆しています。

これは、Excelではなくvbaで処理するほうがずっと速いでしょう。この場合、2つの列をvba配列に読み込み、同じ方法で操作し、それらを読み取ってExcelに戻すことを意味します。

Activesheet.UsedRangeも更新されていますので、代わりにCells(Rows.Count, 1).End(xlUp).Rowの行に沿って何かを使用したい場合があります。

例えば、これは、コードの高速バージョンであるべきである：アレイのbobajobs提案を使用

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

（それが速くなるように）：

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

別の代替が使用しますオートフィルタは数値の行を見つけ、これらの行を列挙します。これは、アドレスが221Bであればどのような）（

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