Question

我在单列中有数据，例如不同的数据集：

原始数据

Class: Country1
Object: State1
Description: DEsc1
Object: State2
Description: DEsc2
Object: State3
Description: DEsc3
Object: State4
Description: DEsc4

Class: Country2
Object: State1
Description: DEsc1
Object: State2
Description: DEsc2
Object: State3
Description: DEsc3
Object: State4
Description: DEsc4

Class: Country3
Object: State1
Description: DEsc1
Object: State2
Description: DEsc2
Object: State3
Description: DEsc3
Object: State4
Description: DEsc4

Class: Country4
Object: State1
Description: DEsc1
Object: State2
Description: DEsc2
Object: State3
Description: DEsc3
Object: State4
Description: DEsc4




I am looking for Excel VBA macro code , which will clean and organize my data.

**Expected Data**

Class       Object    Description <br/>
----------------------------------
Country1    State1    DEsc1
Country1    State2    DEsc2
Country1    State3    DEsc3
Country1    State4    DEsc4
Country2    State1    DEsc1
Country2    State2    DEsc2
Country2    State3    DEsc3
Country2    State4    DEsc4
Country3    State1    DEsc1
Country3    State2    DEsc2
Country3    State3    DEsc3
Country3    State4    DEsc4
Country4    State1    DEsc1
Country4    State2    DEsc2
Country4    State3    DEsc3
Country4    State4    DEsc4


Thanks In Advance!!
KP

[Please find the attached image]

[1]: https://i.stack.imgur.com/otSV1.jpg

Answer 1

您可以尝试：

Option Explicit

Sub test()

    Dim LastRowA As Long, LastRowC As Long, i As Long, y As Long
    Dim strCountry As String

    With ThisWorkbook.Worksheets("Sheet2")

        LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastRowA Step 10

            strCountry = Mid(.Range("A" & i).Value, InStr(1, .Range("A" & i).Value, ":") + 2, Len(.Range("A" & i).Value) - (InStr(1, .Range("A" & i).Value, ":") + 1))

            For y = 2 To LastRowA Step 2

                LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row

                If .Range("A" & y).Value <> "" Then
                    .Range("C" & LastRowC + 1).Value = strCountry
                    .Range("D" & LastRowC + 1).Value = "Object" & Mid(.Range("A" & y).Value, InStr(1, .Range("A" & y).Value, "te") + 2, Len(.Range("A" & y).Value) - (InStr(1, .Range("A" & y).Value, "te") + 1))
                    .Range("E" & LastRowC + 1).Value = Mid(.Range("A" & y + 1).Value, InStr(1, .Range("A" & y + 1).Value, ":") + 2, Len(.Range("A" & y + 1).Value) - (InStr(1, .Range("A" & y + 1).Value, ":") + 1))
                Else
                    Exit For
                End If

            Next y

        Next i

    End With

End Sub

图片：

单列多列的数据分离

1 个答案: