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

Posted 2023-03-06

【中文标题】根据一列中的文本将一列数据分成两部分

【英文标题】：Separate a column data into two based on text in one column

【发布时间】：2020-05-02 09:32:48

【问题描述】：

在我的 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 时面临很多性能问题。无论如何我可以改进代码以更快地运行它。

【问题讨论】：

添加Application.ScreenUpdating = False会减少持续时间。

将你的整个数据读入一个VBA数组（一行代码）；在代码中拆分成另一个 VBA 数组；然后将其写回工作表（也是一行代码）。多个工作表的读/写是一直需要的。

【参考方案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

【讨论】：

感谢方法 1 和 2 仍然需要时间。似乎最后一个代码有一些问题。它只是将第一行数据复制到 I:K

Criteria1:="response" 我希望这个单元格检查只包含这个特定的单词。在我的 C 列中，我有一些其他文本以及这个关键字

然后你可以让它成为 Criteria1:= "=*response*" .. 编辑答案

谢谢。运行顺利，没有任何问题