问用于计数字符串、插入行、复制行、拆分单元格的VBA脚本

EN

Sub ProcessData()
    Dim c As Collection
    Dim arr, recordVector
    Dim i As Long, j As Long
    Dim rng As Range
    Dim part, parts

    'replace with your code to assign the right range etc
    Set rng = ActiveSheet.UsedRange
    j = 3 'replace with right column index, or work it out using Range.Find etc

    arr = rng.Value 'load the data

    'Process the data adding additional rows etc
    Set c = New Collection
    For i = 1 To UBound(arr, 1)
        parts = Split(arr(i, j), "/") 'split the data based on "/"
        For Each part In parts 'loop through each "LC" thing
            recordVector = getVector(arr, i) 'get the row data
            recordVector(j) = part 'replace the "LC" thing
            c.Add recordVector 'add it to our results collection
        Next part
    Next i

    'Prepare to dump the data back to the worksheet
    rng.Clear

    With rng.Parent
        .Range( _
            rng.Cells(1, 1), _
            rng.Cells(1, 1).Offset(c.Count - 1, UBound(arr, 2) - 1)) _
            .Value = getCollectionOfVectorsToArray(c)
    End With

End Sub

'Helper method to return a vector representing our row data
Private Function getVector(dataArray, dataRecordIndex As Long)
    Dim j As Long, tmpArr
    ReDim tmpArr(LBound(dataArray, 2) To UBound(dataArray, 2))
    For j = LBound(tmpArr) To UBound(tmpArr)
        tmpArr(j) = dataArray(dataRecordIndex, j)
    Next j
    getVector = tmpArr
End Function
'Helper method to return an array from a collection of vectors
Function getCollectionOfVectorsToArray(c As Collection)
    Dim i As Long, j As Long, arr
    ReDim arr(1 To c.Count, LBound(c(1), 1) To UBound(c(1), 1))
    For i = 1 To c.Count
        For j = LBound(arr, 2) To UBound(arr, 2)
            arr(i, j) = c(i)(j)
        Next j
    Next i
    getCollectionOfVectorsToArray = arr
End Function

Sub ProcessData_RangeMethod()
    Dim rng As Range
    Dim colIndex As Long
    Dim parts
    Dim currRowIndex As Long

    'replace with your code to assign the right range etc
    Set rng = ActiveSheet.UsedRange

    colIndex = 3 'replace with right column index, or work it out using Range.Find etc

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    currRowIndex = 1
    Do Until currRowIndex > rng.Rows.Count
        parts = Split(rng.Cells(currRowIndex, colIndex), "/")
        If UBound(parts) > 0 Then
            rng.Range(rng.Cells(currRowIndex + 1, 1), rng.Cells(currRowIndex + UBound(parts), rng.Columns.Count)).Insert xlShiftDown
            rng.Rows(currRowIndex).Copy rng.Range(rng.Cells(currRowIndex + 1, 1), rng.Cells(currRowIndex + UBound(parts), rng.Columns.Count))
            rng.Range(rng.Cells(currRowIndex, colIndex), rng.Cells(currRowIndex + UBound(parts), colIndex)).Value = Application.Transpose(parts)
        End If
        currRowIndex = currRowIndex + 1 + UBound(parts)
    Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub