在Excel中將行項目分爲3行

Question

我有一張Excel表格，我需要將項目拆分爲3個不同的行。目前，我的訂單項全部位於同一行。第一行需要創建廣告組，第二行創建文字廣告和網址，第三行添加關鍵字。

請參閱Google鏈接，它包含兩張紙，一張稱爲錯誤，另一張稱爲正確。

https://docs.google.com/spreadsheets/d/1CH_zI6Waky0YCcArCvjAa4x3YbEt8rMEbybZRI-dOoc/edit?usp=sharing

我將不勝感激在解決這個任何幫助。我有30k +產品可以做到這一點。

謝謝！

Answer 1

這是經過測試的，會按照新工作表中所描述的將當前行分成3份，以便原始數據不會被更改。

Sub SplitAds() 

Dim thissheet As Worksheet 
Set thissheet = ActiveSheet 

Sheets.Add 
Dim newsheet As Worksheet 
Set newsheet = ActiveSheet 

'Copy Headers 
thissheet.Range("A1").EntireRow.Copy 
newsheet.Range("A1").PasteSpecial (xlPasteValues) 

Dim newrow As Long 
For x = 0 To thissheet.Range("A65535").End(xlUp).Row 
If Not thissheet.Range("A2").Offset(x, 0).Value = "" Then 
thissheet.Range("A2:C2").Offset(x, 0).Copy 
'Copy & Paste A:C 
newsheet.Range("A2").Offset(newrow, 0).PasteSpecial (xlPasteValues) 
newsheet.Range("A2").Offset(newrow + 1, 0).PasteSpecial (xlPasteValues) 
newsheet.Range("A2").Offset(newrow + 2, 0).PasteSpecial (xlPasteValues) 
'Set Type 
newsheet.Range("L2").Offset(newrow, 0).Value = thissheet.Range("L2").Offset(x, 0).Value 
newsheet.Range("L2").Offset(newrow + 1, 0).Value = thissheet.Range("L2").Offset(x, 0).Value 
newsheet.Range("L2").Offset(newrow + 2, 0).Value = thissheet.Range("L2").Offset(x, 0).Value 
'Set D:J on 2nd 
thissheet.Range("D2:J2").Offset(x, 0).Copy 
newsheet.Range("D2").Offset(newrow + 1, 0).PasteSpecial (xlPasteValues) 
'Set Keyword on 3rd 
newsheet.Range("K2").Offset(newrow + 2, 0).Value = thissheet.Range("K2").Offset(x, 0).Value 
newrow = newrow + 3 
End If 
Next 

End Sub