Разделение данных из одного столбца в несколько столбцов - PullRequest
0 голосов
/ 17 апреля 2019

У меня есть данные в одном столбце, как разные наборы:

Исходные данные

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


1 Ответ

0 голосов
/ 17 апреля 2019

Вы можете попробовать:

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

Изображение:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...