Question

是否有更快的方法来比较来自不同列的文本/数据？似乎需要更长时间才能执行。

Sub StringCom2()


    For Each C In Range("M2:M" & Range("M" & Rows.Count).End(xlUp).Row)
        For Each L In Range("X2:X" & Range("X" & Rows.Count).End(xlUp).Row)
            If C.Cells.Value = "Audio Accessories" And L.Cells.Value = "Headsets" Then
                    L.Cells.Offset(0, 18).Value = "Headphones"
            End If
        Next
    Next

    For Each C In Range("M2:M" & Range("M" & Rows.Count).End(xlUp).Row)
        For Each L In Range("X2:X" & Range("X" & Rows.Count).End(xlUp).Row)
            If C.Cells.Value = "Headsets & Car Kits" And L.Cells.Value = "Headsets" Then
                    L.Cells.Offset(0, 18).Value = "Headsets & Car Kits"
            End If
        Next
    Next

End Sub

Answer 1

您可以使用＆＃34;自动过滤（）＆＃34;方法＆＃34;范围＆＃34;宾语如下（不是我的电脑，所以可能会有一些拼写错误和/或范围引用/偏移调整...）：

Option Explicit

Sub StringCom2()
    With Worksheets("Sheet1") '<--| '<-- change "Sheet1" with your actual sheet name
        With .Range("M1:X" & .Cells(.Rows.Count, "M").End(xlUp).Row) '<--| reference its range in columns M:X from row 1 to column "M" last non empty cell row
            .AutoFilter field:=1, Criteria1:="Headsets" '<--| filter referenced range on its 1st column ("M") with "Headsets"
            .AutoFilter field:=12, Criteria1:="Audio Accessories" '<--|filter referenced range again on its 12th column ("X") with "Audio Accessories"
             If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1, 19).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) = "Headphones"'<--| write in cells offsetted 19 columns right of the matching ones

            .AutoFilter field:=12, Criteria1:="Headsets & Car Kits" '<--|filter referenced range again on its 12th column ("X") with "Headsets & Car Kits"
             If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Offset(1, 19).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) = "Headsets & Car Kits"'<--| write in cells offsetted 19 columns right of the matching ones
         End With
        .AutoFilterMode = False '<--| show all rows back
    End With
End Sub

Answer 2

尝试一下，让我知道它是否更快终止：

Option Explicit

Sub StringCom_SlightlyImproved()

Dim C As Range, L As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets(1)

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

For Each C In ws.Range("M2:M" & ws.Range("M" & ws.Rows.Count).End(xlUp).Row)
    For Each L In ws.Range("X2:X" & ws.Range("X" & ws.Rows.Count).End(xlUp).Row)
        If C.Value2 = "Headsets" Then
            If L.Value2 = "Audio Accessories" Then L.Offset(0, 18).Value2 = "Headphones"
            If L.Value2 = "Headsets & Car Kits" Then L.Offset(0, 18).Value2 = "Headsets & Car Kits"
        End If
    Next L
Next C

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

的变化：

声明所有变量以避免性能较慢的Variants
为子
将两个循环放在一起以保持迭代次数
代码

更新

以下解决方案应该大大加快，因为纸张访问限制在最低限度。相反，所有计算/比较都在内存中用变量完成：

Sub StringCom_Improved()

Dim ws As Worksheet
Dim arrResult As Variant
Dim arrHeadset As Variant
Dim arrAccessories As Variant
Dim i As Long, j As Long, maxM As Long, maxX As Long

Set ws = ThisWorkbook.Worksheets(1)

maxM = ws.Range("M" & ws.Rows.Count).End(xlUp).Row
arrHeadset = ws.Range("M2:M" & maxM).Value2
arrResult = ws.Range("AD2:AD" & maxM).Value2        ' column AD is column M with an offset of 18 columns
maxX = ws.Range("X" & ws.Rows.Count).End(xlUp).Row
arrAccessories = ws.Range("X2:X" & maxX).Value2

For i = LBound(arrHeadset) To UBound(arrHeadset)
    For j = LBound(arrAccessories) To UBound(arrAccessories)
        If arrHeadset(i, 1) = "Headsets" Then
            If arrAccessories(j, 1) = "Audio Accessories" Then arrResult(i, 1) = "Headphones"
            If arrAccessories(j, 1) = "Headsets & Car Kits" Then arrResult(i, 1) = "Headsets & Car Kits"
        End If
    Next j
Next i

ws.Range("AD2:AD" & maxM).Value2 = arrResult

End Sub

Answer 3

更快的方法是使用Excel公式

Sub StringCom2()

    m = Range("M" & Rows.Count).End(xlUp).Row
    x = Range("X" & Rows.Count).End(xlUp).Row

    Set r = Range("X2:X" & x).Offset(, 18)

    r.Formula = "= If( CountIf( M2:M" & m & " , ""Headsets"" ) , " & _
                 " If( X2 = ""Audio Accessories"" , ""Headphones"", " & _
                 " If( X2 = ""Headsets & Car Kits"" , X2 , """" ) , """" ) , """" ) "

    r.Value2 = r.Value2 ' optional to replace the formulas with the values

End Sub

比较不同列的文本的更快方法

3 个答案:

更新