エクセルマクロは、新しい行

Question

私は現在、シートにこのデータを持っているに項目を分け、私は3番目の列にカンマ区切りのエントリを分割して、以下のような新しい行に挿入されて何をしたいのか

Col A Col B Col C 
1  A  angry birds, gaming 
2  B  nirvana,rock,band 

：

Col A Col B Col C 
1  A  angry birds 
1  A  gaming 
2  B  nirvana 
2  B  rock 
2  B  band 

これはVBAで行うことはできますが、自分では理解できないと確信しています。

Answer 1

使用バリアントScripting.Dictionary

Sub ttt() 
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary") 
    Dim x&, cl As Range, rng As Range, k, s 
    Set rng = Range([C1], Cells(Rows.Count, "C").End(xlUp)) 
    x = 1 'used as a key for dictionary and as row number for output 
    For Each cl In rng 
     For Each s In Split(cl.Value2, ",") 
      dic.Add x, Cells(cl.Row, "A").Value2 & "|" & _ 
         Cells(cl.Row, "B").Value2 & "|" & LTrim(s) 
      x = x + 1 
    Next s, cl 
    For Each k In dic 
     Range(Cells(k, "A"), Cells(k, "C")).Value2 = Split(dic(k), "|") 
    Next k 
End Sub 

源：

結果：

Answer 2

これは私が2列のデータに対して持っている答えです。しかし、私は3つの列のためにそれをしたい、誰かがここで私を助けることができますか？

セルループではなくバリアント配列を使用するほうが良いです。データセットが意味をなされたら、はるかにコードワイズです。あなたのコードはもっと長くなります:)

このサンプルは、元のデータを見ることができるように、CとDの列にダンプします。変更する[c1] .Resize（lngCnt、2）.Value2 = Application.Transpose（Y）to [a1] .Resize（lngCnt、2）.Value2 = Application.Transpose（Y）を元のデータに上書きする

[後でブランクを削除するためにregexpで更新されました。つまり、 "band"が "band"になります] Sub SliceNDice() Dim objRegex As Object Dim X Dim Y Dim lngRow As Long Dim lngCnt As Long Dim tempArr() As String Dim strArr Set objRegex = CreateObject("vbscript.regexp") objRegex.Pattern = "^\s+(.+?)$" 'Define the range to be analysed X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2 Redim Y(1 To 2, 1 To 1000) For lngRow = 1 To UBound(X, 1) 'Split each string by "," tempArr = Split(X(lngRow, 2), ",") For Each strArr In tempArr lngCnt = lngCnt + 1 'Add another 1000 records to resorted array every 1000 records If lngCnt Mod 1000 = 0 Then Redim Preserve Y(1 To 2, 1 To lngCnt + 1000) Y(1, lngCnt) = X(lngRow, 1) Y(2, lngCnt) = objRegex.Replace(strArr, "$1") Next Next lngRow 'C：D [c1] .Resize（lngCnt、2）.Value2 = Application .Transpose（Y） End Sub

Answer 3

これは洗練された解決策ではありませんが、私は妻と時間を過ごす必要があります。

しかし、それについてさらに別の考え方があります。

このコードは、シートは、シート4及びC.

をCOLれる分割する必要がある範囲と呼ばれていることを前提とし

Dim lastrow As Integer 
Dim i As Integer 
Dim descriptions() As String 

With Worksheets("Sheet4") 
    lastrow = .Range("C1").End(xlDown).Row 
    For i = lastrow To 2 Step -1 
     If InStr(1, .Range("C" & i).Value, ",") <> 0 Then 
      descriptions = Split(.Range("C" & i).Value, ",") 
     End If 
     For Each Item In descriptions 
      .Range("C" & i).Value = Item 
      .Rows(i).Copy 
      .Rows(i).Insert 
     Next Item 
     .Rows(i).EntireRow.Delete 

    Next i 
End With 

Answer 4

これは、あなたが望むことを行います。

Option Explicit 

Const ANALYSIS_ROW As String = "C" 
Const DATA_START_ROW As Long = 1 

Sub ReplicateData() 
    Dim iRow As Long 
    Dim lastrow As Long 
    Dim ws As Worksheet 
    Dim iSplit() As String 
    Dim iIndex As Long 
    Dim iSize As Long 

    'Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    With ThisWorkbook 
     .Worksheets("Sheet1").Copy After:=.Worksheets("Sheet1") 
     Set ws = ActiveSheet 
    End With 

    With ws 
     lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row 
    End With 


    For iRow = lastrow To DATA_START_ROW Step -1 
     iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",") 
     iSize = UBound(iSplit) - LBound(iSplit) + 1 
     If iSize = 1 Then GoTo Continue 

     ws.Rows(iRow).Copy 
     ws.Rows(iRow).Resize(iSize - 1).Insert 
     For iIndex = LBound(iSplit) To UBound(iSplit) 
      ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex) 
     Next iIndex 
Continue: 
    Next iRow 

    Application.CutCopyMode = False 
    Application.Calculation = xlCalculationAutomatic 
    'Application.ScreenUpdating = True 
End Sub