excel - VBA - 需要解析第二列并固定到底部，但卡住了

Question

目前有一个如下所示的数据集... 'For Each Item In Split(.Cells(rw, 4), ",") '从 ","中拆分风险字符串

我可以成功解析“数据1”列，但是它停止了，我无法弄清楚为什么……我认为下一个列会将其推到“数据2”并开始将其滑到最后一行下方.帮助？!
这让我有了这个..

但!我要这个...

子分割()

Dim i As Long, rw As Long, col As Long, rwCnt As Long, colCnt As Long

i = 2
With Sheets("Sheet2")
    .Cells(1, 7) = "Category"
    .Cells(1, 8) = "Subcategory"
    .Cells(1, 9) = "Notes"
    .Cells(1, 10) = "Label"
    .Cells(1, 11) = "Rank"

    rwCnt = .Cells(.Rows.Count, 1).End(xlUp).Row 'last non-empty row number for labels & words
    colCnt = .Cells(.Columns.Count, 1).End(xlToLeft).Column 'last non-empty column for columns
    For col = 1 To colCnt 'from column 1 til last non-emty column
        For rw = 2 To rwCnt 'from row 1 til last non-empty row
                If .Cells(rw, col) <> "" Then ' 'if the splitted part of the string is not empty
                    .Cells(i, 7) = .Cells(rw, 1) 'populate column 7 with column 1
                    .Cells(i, 8) = .Cells(rw, 2)   'populate column 8 with column 2
                    .Cells(i, 9) = .Cells(rw, 3) 'populate column 9 with column 3
                    .Cells(i, 10) = Split(.Cells(rw, col), ",") 'populate low with splitted part of the string
                    .Cells(i, 11) = "Low"
                    .Cells((rwCnt + i), 10) = Split(.Cells(rw, col), ",") 'add med to bottom of low
                    .Cells((rwCnt + i), 11) = "Med"
                    'need to add high to bottom of med (??rwCnt*2 + i )??
                    i = i + 1 ' increase i variable by one to be able to write the next empty row for the next loop
                End If
        Next rw
    Next col
End With

'.Columns("A:F").EntireColumn.Delete 'when all data is extracted, delete

End Sub

Answer 1

你可以这样做:

Sub Tester()

    Dim ws As Worksheet, rw As Long, rwOut As Long, arr, col As Long, v, e
    
    Set ws = ActiveSheet 'or whatever
    
    ws.Cells(1, 8).Resize(1, 5).Value = _
          Array("Category", "SubCat", "Notes", "Label", "Rank")
    
    rwOut = 2
    For col = 4 To 6
        For rw = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
            v = ws.Cells(rw, col).Value
            If Len(v) > 0 Then
                arr = Split(v, ",")
                For Each e In arr
                    'Cat, subcat & notes
                    ws.Cells(rwOut, 8).Resize(1, 3).Value = _
                                     ws.Cells(rw, 1).Resize(1, 3).Value
                    
                    ws.Cells(rwOut, 11).Value = Trim(e)

                    ws.Cells(rwOut, 12).Value = _
                                     Array("Low", "Med", "High")(col - 4)

                    rwOut = rwOut + 1
                Next e
            End If
        Next rw
    Next col

End Sub