Question

我编写了以下代码来查看地址列表。地址第一行（Add1）本身就是一个建筑物编号，它与地址第二行（Add2）连接在一起。例如：

Add1 “10”， Add2 “Baker Street”

变为：

Add1 “10 Baker Street”， 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

对数组使用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 2

我注意到的第一件事是你最后没有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 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

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

3 个答案: