我正在寻找这个操作： How do I duplicate rows based on cell contents (cell contains semi-colon seperated data)
但增加了一栏： Starting table vs End result
我有什么：
| Name | Size | Photo |
|--------|------------|---------|
| Tshirt | 10, 12, 14 | 144.jpg |
| Jeans | 30, 40, 42 | 209.jpg |
| Dress | 8 | 584.jpg |
| Shoe | 6 | 178.jpg |
我想要的是什么：
| Name | Size | Photo | Primary |
|--------|------|---------|---------|
| Tshirt | 10 | 144.jpg | 1 |
| Tshirt | 12 | 144.jpg | 0 |
| Tshirt | 14 | 144.jpg | 0 |
| Jeans | 30 | 209.jpg | 1 |
| Jeans | 40 | 209.jpg | 0 |
| Jeans | 42 | 209.jpg | 0 |
| Dress | 8 | 584.jpg | 1 |
| Shoe | 6 | 178.jpg | 1 |
现在我找到的代码完美无缺，但我不知道如何添加“主要”列。
Sub SplitCell()
Dim cArray As Variant
Dim cValue As String
Dim rowIndex As Integer, strIndex As Integer, destRow As Integer
Dim targetColumn As Integer
Dim lastRow As Long, lastCol As Long
Dim srcSheet As Worksheet, destSheet As Worksheet
targetColumn = 2 'column with semi-colon separated data
Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed
destRow = 0
With srcSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For rowIndex = 1 To lastRow
cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
cArray = Split(cValue, ";") 'splitting semi-colon separated data in an array
For strIndex = 0 To UBound(cArray)
destRow = destRow + 1
destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
Next strIndex
Next rowIndex
End With
End Sub
感谢您的帮助！
答案 0 :(得分：2)
尝试对代码稍作修改，您必须声明其他变量Dim priority As Boolean：
For rowIndex = 1 To lastRow
cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
cArray = Split(cValue, ";") 'splitting semi-colon separated data in an array
priority = True
For strIndex = 0 To UBound(cArray)
destRow = destRow + 1
destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
destSheet.Cells(destRow, 4) = IIf(priority, 1, 0)
priority = False
Next strIndex
Next rowIndex
答案 1 :(得分：0)
这是一种稍微不同的方法，它避免了第二次循环。
Sub SplitCell()
Dim cArray As Variant
Dim rowIndex As Long, destRow As Long
Dim targetColumn As Long
Dim lastRow As Long, lastCol As Long
Dim srcSheet As Worksheet, destSheet As Worksheet
targetColumn = 2 'column with semi-colon separated data
Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed
destRow = 1
With srcSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
destSheet.Cells(1, 4).Value = "Primary"
For rowIndex = 1 To lastRow
cArray = Split(srcSheet.Cells(rowIndex, targetColumn), ";") 'splitting semi-colon separated data in an array
destSheet.Cells(destRow, 1).Resize(UBound(cArray) + 1).Value = srcSheet.Cells(rowIndex, targetColumn - 1).Value
destSheet.Cells(destRow, 2).Resize(UBound(cArray) + 1).Value = Application.Transpose(cArray)
destSheet.Cells(destRow, 3).Resize(UBound(cArray) + 1).Value = srcSheet.Cells(rowIndex, targetColumn + 1).Value
If rowIndex > 1 Then destSheet.Cells(destRow, 4).Value = 1
If UBound(cArray) > 0 Then
destSheet.Cells(destRow + 1, 4).Resize(UBound(cArray)).Value = 0
End If
destRow = destSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Next rowIndex
End With
End Sub
答案 2 :(得分：0)
注意：我正在使用这个＆＃34;，＆＃34;分隔符，因为您的数据显示的是而不是您的代码正在使用＆＃34;;＆＃34;。如有必要，只需翻转。
Option Explicit
Sub SplitCell()
Dim cArray As Variant
Dim cValue As String
Dim rowIndex As Long, strIndex As Long, destRow As Long
Dim targetColumn As Long
Dim lastRow As Long, lastCol As Long
Dim srcSheet As Worksheet, destSheet As Worksheet
targetColumn = 2 'column with semi-colon separated data
Set srcSheet = ThisWorkbook.Worksheets("Sheet1") 'sheet with data
Set destSheet = ThisWorkbook.Worksheets("Sheet2") 'sheet where result will be displayed
destRow = 0
With srcSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For rowIndex = 1 To lastRow
cValue = .Cells(rowIndex, targetColumn).Value 'getting the cell with semi-colon separated data
cArray = Split(cValue, ",") 'splitting semi-colon separated data in an array
For strIndex = 0 To UBound(cArray)
destRow = destRow + 1
destSheet.Cells(destRow, 1) = .Cells(rowIndex, 1)
destSheet.Cells(destRow, 2) = Trim(cArray(strIndex))
destSheet.Cells(destRow, 3) = .Cells(rowIndex, 3)
If rowIndex = 1 Then
destSheet.Cells(destRow, 4) = "Primary"
Else
If strIndex = 0 Then
destSheet.Cells(destRow, 4) = 1
Else
destSheet.Cells(destRow, 4) = 0
End If
End If
Next strIndex
Next rowIndex
End With
End Sub
答案 3 :(得分：0)
你的整个潜艇可以归结为：
Sub SplitCell()
Dim vals As Variant
vals = ThisWorkbook.Worksheets("Sheet001").Range("A1").CurrentRegion.value
Dim iVal As Long
With ThisWorkbook.Worksheets("Sheet002")
.Range("A1:C1").value = Application.index(vals, 1, 0)
.Range("D1").value = "Primary"
For iVal = 2 To UBound(vals)
With .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(Split(vals(iVal, 2) & ",", ",")))
.Offset(, 0).value = vals(iVal, 1)
.Offset(, 1).value = Application.Transpose(Split(vals(iVal, 2) & ",", ","))
.Offset(, 2).value = vals(iVal, 3)
.Offset(, 3).value = Application.Transpose(Split("1," & String(.Rows.Count - 1, ","), ","))
End With
Next
.Range("D1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeBlanks).value = 0
End With
End Sub