將單個單元格中的字符串劃分爲多個單元格

Question

我有需要將其分成單個點的數據。我的宏將數據繪製爲散點圖，其中：列A作爲圖表的標題，列B作爲X軸，列C和D作爲Y軸。我需要的是，當產品ID列出多於1個數字時，將數字分成自己的行，並保留列B，C和D對於原始創建的每一行都相同。因此，對於第167行，我希望分別在B，C和D中分別具有包裝，200和100的3行（001,002,003）。我不知道從哪裏開始。我試圖構建一個宏，但是當我試圖記錄一個「查找」公式來運行數據時，我立即被絆倒了。任何幫助將不勝感激。

列A：001，002，003 // B欄：包裝// C列：200 //列d：100

抱歉，我不能發佈我的數據的截圖，論壇贏得」不要讓我。如果您有任何問題，請告訴我，我一定會經常入住。

在此先感謝。

Answer 1

Sub DivideData() 

「這分裂合併到同一行中的任何代碼，到自己單獨的行用自己獨立的數據

Dim a, b, txt As String, e, s, x As Long, n As Long, i As Long, ii As Long 
With Range("a1").CurrentRegion 
    a = .Value 
    txt = Join$(Application.Transpose(.Columns(1).Value)) 
    x = Len(txt) - Len(Replace(txt, ",", "")) + .Rows.Count 
    ReDim b(1 To x * 2, 1 To UBound(a, 2)) 
    For i = 1 To UBound(a, 1) 
     For Each e In Split(a(i, 1), ",") 
      If e <> "" Then 
       For Each s In Split(e, "-") 
        n = n + 1 
        For ii = 1 To UBound(a, 2) 
         b(n, ii) = a(i, ii) 
        Next 
        b(n, 1) = s 
       Next 
      End If 
     Next 
    Next 
    With .Resize(n) 
     .Columns(1).NumberFormat = "@" 
     .Value = b 
    End With 
End With 

末次

Answer 2

您將需要解析列A中的數據。我會通過將字符串拆分爲數組，然後遍歷數組項以在必要時添加/插入其他行。

在沒有看到你的工作表的情況下，我可能會從這樣的事情開始，它會將你的單元格值從A列分割到一個數組中，然後你可以迭代數組中的項來根據需要操縱工作表。

Sub TestSplit() 
Dim myString as String 
Dim myArray() as String 
Dim cell as Range 
Dim i as Long 

For each cell in Range("A2",Range("A2").End(xlDown)) 
    myString = cell.Value 

    myArray = Split(myString, ",") '<-- converts the comma-delimited string in to an array 
    For i = lBound(myArray) to uBound(myArray) 
     If i >= 1 Then 
      'Add code to manipulate your worksheet, here 
     End If 
    Next 
Next 
End Sub 

Answer 3

我又寫道這個非常迅速，沒有效率很在意，但是這應該做的伎倆：

Sub SplitUpVals() 

    Dim i As Long 
    Dim ValsToCopy As Range 
    Dim MaxRows As Long 
    Dim ValToSplit() As String 
    Dim CurrentVal As Variant 


    MaxRows = Range("A1").End(xlDown).Row 

    For i = 1 To 10000000 

     ValToSplit = Split(Cells(i, 1).Value, ",") 
     Set ValsToCopy = Range("B" & i & ":D" & i) 

     For Each CurrentVal In ValToSplit 

      CurrentVal = Trim(CurrentVal) 
      Cells(i, 1).Value = CurrentVal 
      Range("B" & i & ":D" & i).Value = ValsToCopy.Value 

      Cells(i + 1, 1).EntireRow.Insert 
      i = i + 1 
      MaxRows = MaxRows + 1 
     Next 

     Cells(i, 1).EntireRow.Delete 

    If i > MaxRows Then Exit For 

    Next i 

    End Sub 

作爲一個說明，確保沒有數據單元格的數據之下，因爲它可能被刪除。

Answer 4

這是一個更好的解決方案（現在我有更多的時間:)） - 希望這是訣竅！

Sub SplitUpVals() 

    Dim AllVals As Variant 
    Dim ArrayIndex As Integer 
    Dim RowLooper As Integer 


    AllVals = Range("A1").CurrentRegion 
    Range("A1").CurrentRegion.Clear 

    RowLooper = 1 

    For ArrayIndex = 1 To UBound(AllVals, 1) 
     ValToSplit = Split(AllVals(ArrayIndex, 1), ",") 

     For Each CurrentVal In ValToSplit 

      CurrentVal = Trim(CurrentVal) 
      Cells(RowLooper, 1).Value = CurrentVal 
      Cells(RowLooper, 2).Value = AllVals(ArrayIndex, 2) 
      Cells(RowLooper, 3).Value = AllVals(ArrayIndex, 3) 
      Cells(RowLooper, 4).Value = AllVals(ArrayIndex, 4) 

      RowLooper = RowLooper + 1 
     Next 

    Next ArrayIndex 

    End Sub