根据一列中的文本将一列数据分成两部分

Question

在我的 excel 中，C 列总是会有 response 或 resolution 的文本。我的目标是基于此分隔 A:C 列。如果 C 列有文本 response，则将 A:C 列复制到 E:G，否则将 A:C 复制到 I:K

我现在使用下面的代码：

    Sub SLACalc()
    Dim DTA As Workbook
    Dim SLADATA As Worksheet

    Set DTA = Excel.Workbooks("main.xlsm")
    Set SLADATA = DTA.Worksheets("SLA DATA")

    For i = 2 To SLADATA.Cells(Rows.Count, "A").End(xlUp).Row

        If InStr(Cells(i, "C").Value, "response") > 0 Then

            SLADATA.Cells(i, "E").Value = SLADATA.Cells(i, "A").Value
            SLADATA.Cells(i, "F").Value = SLADATA.Cells(i, "B").Value
            SLADATA.Cells(i, "G").Value = SLADATA.Cells(i, "C").Value

         Else

            SLADATA.Cells(i, "I").Value = SLADATA.Cells(i, "A").Value
            SLADATA.Cells(i, "J").Value = SLADATA.Cells(i, "B").Value
            SLADATA.Cells(i, "K").Value = SLADATA.Cells(i, "C").Value

        End If
    Next i

End Sub

当我在A:C 中的行较少时，这可以正常工作。现在我的行​​数接近 20,000 行，并且在使用 excel 时面临很多性能问题。无论如何我可以改进代码以更快地运行它。

Answer 1

Assuming you want to split the table on the same row as per you code

First,

你可以像这样减少循环代码

For i = 2 To SLADATA.Cells(Rows.Count, "A").End(xlUp).Row
    If InStr(Cells(i, "C").Value, "response") > 0 Then
        SLADATA.Range(Cells(i, "E"), Cells(i, "G")).Value = SLADATA.Range(Cells(i, "A"), Cells(i, "C")).Value
     Else
        SLADATA.Range(Cells(i, "I"), Cells(i, "K")).Value = SLADATA.Range(Cells(i, "A"), Cells(i, "C")).Value
    End If
Next i

Second

尝试数组：数组有助于大大减少处理时间。

Sub SLACalc2()
    Dim DTA As Workbook
    Dim SLADATA As Worksheet
    Set DTA = Excel.Workbooks("main.xlsm")
    Set SLADATA = DTA.Worksheets("SLA DATA")
    LRow = SLADATA.Cells(Rows.Count, "A").End(xlUp).Row
    DataArr = SLADATA.Range("A2:C" & LRow).Value

    For i = 1 To UBound(DataArr)
        If Application.Index(DataArr, i, 3) = "response" Then
            SLADATA.Range(Cells(i + 1, "E"), Cells(i + 1, "G")).Value = Application.Index(DataArr, i)
         Else
            SLADATA.Range(Cells(i + 1, "I"), Cells(i + 1, "K")).Value = Application.Index(DataArr, i)
        End If
    Next i

End Sub

this timer ;我可以检查处理时间。第一种方法更快。可能是因为，它避免了从数组中存储和检索数据。

但是，如果您只想要 Ron Rosenfeld 在对问题的评论中建议的单独表格，最好使用自动过滤器。它会比数组更快。

Sub Macro1()
    Dim DataRng As Range
    Set DataRng = Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row)

    DataRng.AutoFilter Field:=3, Criteria1:="=*response*"
    DataRng.Cells.SpecialCells(xlCellTypeVisible).Copy
    Range("E1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    DataRng.AutoFilter Field:=3, Criteria1:="=*resolution*"
    DataRng.Cells.SpecialCells(xlCellTypeVisible).Copy
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    ActiveSheet.ShowAllData

End Sub