Excel 连接地址行-优化和最佳实践

我编写了以下代码来查看地址列表。其中地址行1（Add1）本身是一个建筑编号，它与地址行2（Add2）相连。例如：

地址1“10”地址2“贝克街”

变成：

地址1贝克街10号，地址2“

（地址行1始终命名为Add1，但它所在的实际列对于每个文件都会发生更改。）

---

我是VBA新手，但我知道我应该避免使用选择和激活。如果有人能就如何在最佳实践和/或优化方面改进此代码给我一些建议，我将不胜感激

关于这一点，我注意到的第一件事是，您的

Application.screenUpdate=False

最后没有

Application.screenUpdate=True

，这将被视为不好的做法

然而，您觉得有必要将

Application.screenUpdatement=False

放进去的事实暗示了一个很大的优化可能性

用vba进行处理（几乎）总是比用excel更快。在本例中，这意味着将两列读入vba数组，以相同的方式对其进行操作，然后将它们读回excel

Activesheet.UsedRange在更新自身时也有点松懈，因此您可能希望使用类似于
单元格（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

对数组使用bobajobs建议（因为它更快）：

另一种方法是使用自动筛选查找数字行，然后通过这些行进行枚举。这应该比使用IsNumeric（）检查每一行要快

如果地址是221b怎么办？（嗯，你确实用过贝克街，所以尽管我最好用著名的门牌号）。这不会以数字形式返回。感谢您的建议和修改后的代码，为我指明了正确的方向。感谢您提供的关于重新排列的额外建议，我有很多要学习的！
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

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

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