腳本在Excel中 - 插入新行基於逗號分隔的列表

我有一個問題，即如何將我對下面的情況下編寫一個宏：腳本在Excel中 - 插入新行基於逗號分隔的列表

我有一組數據，並有一個單元是對於這些數據中的一部分，包含多個用逗號分隔的項目。每次在這一列中都有一個逗號時，我希望在那裏添加一個新行，並添加上面所有的相同數據，但與當前列的前一個項目之後的內容相同......我知道這一定很難遵循，所以這裏有一個例子：

ORIGINAL：

應該是：

所以基本上，每次這種遭遇在CORRESPONDING PART列一個逗號，它會創建一個新的行與以前一樣數據，但逗號後的單個部分。

來源

2013-05-14 Shivster

http://stackoverflow.com/questions/8231368/split-strings-in-excel-vba – jswolf19 2013-05-14 15:08:01

正如jswolf19所提到的，您可以使用SPLIT函數將分隔字符串轉換爲數組。然後，只需遍歷數組中的項目並根據需要插入新行。

下面的過程應該讓你開始。

我假設你的數據在列A：E中，並使用rng變量進行設置。根據需要修改它。每OP訂正

代碼註釋

Sub SplitPartsRows() 
Dim rng As Range 
Dim r As Long 
Dim arrParts() As String 
Dim partNum As Long 
'## In my example i use columns A:E, and column D contains the Corresponding Parts ## 

Set rng = Range("A1:BI13876") '## Modify as needed ##' 

r = 2 
Do While r <= rng.Rows.Count 
    '## Split the value in column BB (54) by commas, store in array ## 
    arrParts = Split(rng(r, 54).Value, ",") 
    '## If there's more than one item in the array, add new lines ## 
    If UBound(arrParts) >= 1 Then '## corrected this logic for base 0 array 
     rng(r, 54).Value = arrParts(0) 

     '## Iterate over the items in the array ## 
     For partNum = 1 To UBound(arrParts) 
      '## Insert a new row ##' 
      '## increment the row counter variable ## 
      r = r + 1 
      rng.Rows(r).Insert Shift:=xlDown 

      '## Copy the row above ##' 
      rng.Rows(r).Value = rng.Rows(r - 1).Value 

      '## update the part number in the new row ##' 
      rng(r, 54).Value = Trim(arrParts(partNum)) 

      '## resize our range variable as needed ## 
      Set rng = rng.Resize(rng.Rows.Count + 1, rng.Columns.Count) 

     Next 

    End If 
'## increment the row counter variable ## 
r = r + 1 
Loop 

End Sub

來源

2013-05-14 15:18:36

的可能的複製這是偉大的，謝謝！然而，E3在「Set rng = Range（」A1：E3「）」中的意義是什麼 – Shivster 2013-05-14 15:50:32

在我的示例數據中，E列是我表中的最後一列，第3行是我表中的最後一行，ergo ，'E3'是表格中的最後一個單元格。因此，我們設置'rng'變量來表示從單元格'A1'開始並以單元格'E3'結尾的表格。 – 2013-05-14 15:54:22

不是E4最後一個細胞？ – Shivster 2013-05-14 16:24:06

嘗試此作爲宏：子mcrSplit_and_Insert（）昏暗我只要，R長，RWS長，c以範圍，VC爲變對錯誤轉到下通 Application.EnableEvents =假 Application.ScreenUpdating =假

For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 
    If InStr(1, Cells(r, 4).Value, ",") > 0 Then 
     rws = Len(Cells(r, 4).Value) - Len(Replace(Cells(r, 4).Value, ",", vbNullString)) 
     Cells(r + 1, 4).Resize(rws, 1).EntireRow.Insert 
     Cells(r, 1).Resize(rws + 1, 9).FillDown 
     For i = 0 To rws 
      For Each c In Cells(r + i, 1).Resize(1, 9) 
       If InStr(1, c.Value, ",") > 0 Then 
        vC = Split(c.Value, ",") 
        c = vC(i) 
       End If 
       If IsNumeric(c) Then c = c.Value 
      Next c 
     Next i 
    End If 
Next r 
Columns(2).NumberFormat = "m/d/yy"

通電路： Application.ScreenUpdating =真 Application.EnableEvents =真結束小組

來源

2014-03-03 11:41:15

腳本在Excel中 - 插入新行基於逗號分隔的列表

回答

相關問題