需要帮助拆分Excel中的行与macros

我有一张表，我试图进入一个特定的格式。 目前，我的订单项都位于同一行。 以下是目前的版本与我需要的样式 – https://docs.google.com/spreadsheets/d/1CH_zI6Waky0YCcArCvjAa4x3YbEt8rMEbybZRI-dOoc/edit#gid=0

我的代码的问题是，它为每个广告组共创build了9行。 每个广告组应只有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 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 Next End Sub 

将不胜感激任何帮助。 谢谢！

Answer 1

我认为你的问题是你一次增加一行，而你的newrow一次递增三。 因此，您正在为每一个创build三行。

你可以解决这个问题，可能在你的for循环中使用step 3 ，或者通过改变for到一段while ，然后手动增加3，你用newrows ：

 Sub SplitAds() Dim thissheet, newsheet As Worksheet Set thissheet = ActiveSheet Set newsheet = Sheets.Add Dim x, maxRow, newrow As Long 'Copy Headers thissheet.Range("A1").EntireRow.Copy newsheet.Range("A1").PasteSpecial (xlPasteValues) maxRow = thissheet.Range("A65535").End(xlUp).Row - 1 While x < maxRow 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 x = x + 3 newrow = newrow + 3 Wend End Sub