☰

Excel、VBA セルの値を複数の行に分割する

tag-icon • tag-icon microsoft-excel-2010 vba
Excel、VBA セルの値を複数の行に分割する

Excel でいくつかの情報を自動化しようとしています。

列 A の値を「事業分野」 (列 E) の数で均等に分割し、各「事業分野」を別々の行に表示する必要があります。

それは可能ですか？また、どうすればいいですか？

入力：

Amount   summary_type   Application         Cost Source   Line of Business
0,6      Employee       eDrive Monitoring   eDrive        R&D; APAC; Group IT;

期待される結果：

Amount   summary_type   Application         Cost Source   Line of Business
0,2      Employee       eDrive Monitoring   eDrive        R&D;
0,2      Employee       eDrive Monitoring   eDrive        APAC;
0,2      Employee       eDrive Monitoring   eDrive        Group IT;

答え1

「Line of Business」内のすべてのジョブがコロンで終わっていると仮定すると、次のコードで可能です。

元に戻すことはできないので、まずバックアップを取っておくことを忘れないでください。

Public Sub SortRecords()

Dim intENDROW As Integer
Dim intCOUNTER As Integer
Dim intCOUNTER2 As Integer
Dim intSTRINGLENGTH As Integer
Dim intNUMBERCOLON As Integer
Dim intSTARTROW As Integer
Dim currDIVIDED As Currency
Dim intSTART As Integer
Dim intPOS As Integer

intENDROW = Range("A65536").End(xlUp).Row  'Get last row containing data
intSTARTROW = intENDROW + 3

' Re-populate headers
Range("A" & intENDROW + 2).Value = Range("A1").Text
Range("B" & intENDROW + 2).Value = Range("B1").Text
Range("C" & intENDROW + 2).Value = Range("C1").Text
Range("D" & intENDROW + 2).Value = Range("D1").Text
Range("E" & intENDROW + 2).Value = Range("E1").Text

For intCOUNTER = 2 To intENDROW
    intNUMBERCOLON = 0
    intSTART = 1
    intSTRINGLENGTH = Len(Range("E" & intCOUNTER).Text) ' Get length of string containing "Line of Business"
    For intCOUNTER2 = 1 To intSTRINGLENGTH
        If Mid(Range("E" & intCOUNTER).Text, intCOUNTER2, 1) = ";" Then intNUMBERCOLON = intNUMBERCOLON + 1 ' Count how many colons are in this line
    Next

    If intNUMBERCOLON > 0 Then
        currDIVIDED = Range("A" & intCOUNTER).Value / intNUMBERCOLON ' Get average value of Amount column

        For intCOUNTER2 = 1 To intNUMBERCOLON
            intPOS = InStr(intSTART, Range("E" & intCOUNTER).Text, ";", vbTextCompare)  ' Find each instance of a colon
            Range("E" & intSTARTROW + intCOUNTER2 - 1).Value = Mid(Range("E" & intCOUNTER).Text, intSTART, intPOS - intSTART + 1) ' Copy text before colon to new line
            intSTART = intPOS + 2 ' Update start search position
        Next

        For intCOUNTER2 = intSTARTROW To (intNUMBERCOLON + intSTARTROW - 1)
            Range("A" & intCOUNTER2).Value = currDIVIDED
            Range("B" & intCOUNTER2).Value = Range("B" & intCOUNTER).Text
            Range("C" & intCOUNTER2).Value = Range("C" & intCOUNTER).Text
            Range("D" & intCOUNTER2).Value = Range("D" & intCOUNTER).Text

        Next
        intSTARTROW = intSTARTROW + intNUMBERCOLON
    End If
Next

Range("A1", "A65536").NumberFormat = "General" ' Restore Amount column to a standard number

End Sub

これにより、次の結果が得られます。 ビフォーイメージ

これに対して:

残像

コピー＆ペーストする前に確認できるよう、カットしたデータを同じシートに載せてあります。

MS Office に VBA を追加するにはどうすればよいですか?

関連情報