Excel 根据一列中的文本将一列数据分隔为两列

在我的excel中，C列总是包含响应或解析文本。我的目标是在此基础上分离A:C列。如果C列有文本响应，则将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中的行数较少时，这工作正常。现在，我的行数接近20000，并且在excel中面临很多性能问题。我是否可以改进代码以更快地运行它。

假设您希望按照代码在同一行上拆分表

首先,

您可以减少循环代码，如

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

第二

尝试阵列：阵列有助于大幅减少处理时间

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

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

但是，如果您只是想按照罗恩·罗森菲尔德（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

---

添加Application.ScreenUpdate=False将缩短持续时间。将整个数据读入VBA数组中一行代码；在代码中拆分为另一个VBA数组；然后将它写回工作表，也写一行代码。多个工作表的读/写操作一直在占用时间。感谢方法1和2仍在占用时间。似乎最后的代码有一些问题。它只是将第一行数据复制到I:KCriteria1:=响应中，我希望这个单元格检查只包含这个特定的单词。在我的C列中，我有一些其他文本以及这个关键字，然后您可以将其作为标准1:==*响应*。。编辑回答谢谢。它工作正常，运行平稳，没有任何问题