Блог

В настоящее время есть набор данных, подобный приведенному ниже… ‘Для каждого элемента в Split(.Ячейки (rw, 4), «,») ‘разделяют строку на риск из «,»

Я могу успешно проанализировать столбец «данные 1», но он останавливается, и я ни за что на свете не могу понять, почему.. Я думал, что следующий столбец переместит его в «данные 2» и начнет сдвигать его ниже последней строки. Помогите ?!

что оставляет меня с этим..

НО! Я хочу это…

Sub splt()

 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 amp; 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
  

Вы можете сделать это так:

 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 amp; 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