循环遍历excel工作表中的行，如果单元格不为空，则复制范围 [英] Loop through rows in an excel worksheet and copy a range if the cell isn't blank
问题描述
我从我们的网站购物车下载，不格式化数据，需要如何加载到一些新的销售订单/发票生成软件。
这里的一个例子是一个图片的链接，显示了数据当前的外观（工作簿被称为Orders.csv，但我可以如果需要，转换为xlsx）：
http://web225.extendcp.co.uk/fiercepc.co.uk/img1.jpg
正如你可以看到客户购买多个产品（不是产品的数量，完全不同的产品），它被列在整个行。第一个产品从H列开始，第二列从第O列开始，第三列从第五列开始，等等。
我需要显示如下数据： / p>
http：/ /web225.extendcp.co.uk/fiercepc.co.uk/img2.jpg
所以每个产品都在彼此之下和同一个客户之前的细节。这样，发票软件可以检查每个订单ID，并相应地创建一张发票，显示所有不同的产品。
我不知道该怎么做。我想它需要一个循环的宏，它检查一个行是否有单元格中的数据，然后相应地复制范围。此外，宏将需要在不同的工作簿（可能称为宏），因此它将作用于此下载，因为它将是每次下载时的新工作簿。我希望这是有道理的。
我相信这对于某人来说很容易，而不是我。请帮忙！理想情况下，我需要宏解释，所以我可以操纵范围等，因为这只是一个示例电子表格，实际表格要大得多，包含更多的数据。
我设法从elsewere得到我自己的问题的答案，但是我认为我可以与所有可能感兴趣的人分享答案，因为答复是现在和深入的。
'****此宏用于同一工作簿中的工作表
'****如果要传输数据另一个工作簿你
'****将不得不改变一些代码，但想法是一样的
Sub copydata（）
Dim x As Integer
Dim y As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
设置ws1 =工作表（Ouput sheet）无论您的工作表是
设置ws2 =工作表（订单）或任何您的工作表被称为
'项目1 - 我打电话给单独的部分，每个订单项是我n你的工作表项目1，项目2
'这包括项目1的列HN等等
r = 3'这是您的数据将输出的第一行
x = 3'这是您要检查数据的第一行
Do Until ws2.Range（A& x）='这将循环，直到列A为空，将列设置为任何您想要的
'，但它不能有空白，否则将停止循环。选择一个列，
'总是要有数据。
如果不是ws2.Range（H& x）.Value =然后'这将检查您的列H以确保它不为空
'如果为空，它将继续到下一行，否则复制数据。
'如果
'有一个订单的商品1
'的产品，这个列应该是一些东西，即不要选择列J，如果它有空格，那里有
'实际上是一个订单的项目
'这部分复制数据，=符号左边的工作表是一个数据将写入
ws1.Range（A& r）.Value = ws2.Range（A& x）.Value'订单日期
ws1.Range（B& r）.Value = ws2.Range（B& x）.Value'Order ID
ws1.Range（C& r）.Value = ws2.Range（C& x） .Value'Customer
ws1.Range（D& r）.Value = ws2.Range（D& x）.Value'Billing Add
ws1.Range（E& ; r）.Value = ws2.Range（E& x）.Value'Subtotal
ws1.Range（F& r）.Value = ws2.Range（F& x）总计金额
ws1.Range（H）.Value = ws2.Range（G& x） & r）.Value = ws2.Range（H& x）.Value'Product ID
ws1.Range（I& r）.Value = ws2.Range（I& x）.Value'列J - 可以不读这些
ws1.Range（J& r）.Value = ws2.Range（J& x）.Value'列K
ws1.Range（K& r）.Value = ws2.Range（K& x） .Value'L
ws1.Range（L& r）.Value = ws2.Range（L& x）.Value'Price
ws1.Range（M& r）.Value = ws2.Range（M& x）.Value'属性
r = r + 1'当匹配的情况下，进度r和x
x = x + 1
Else
x = x + 1'当没有匹配的案例时，只提前x（检查下一行）
'ie你的输出行停留在下一行，最后写入数据
'，而x前进
End If
循环'项目1结束
'项目2
x = 3'这一次我们只定义x，我们要r保持在哪里，所以它可以继续复制数据到一个
'无缝列表
做直到ws2.Range（A& x）=仍然希望保持不变
如果不是ws2.Range（O& x）.Value =然后'这个需要更改以匹配您的第二个项目
'中的列，ws1上的范围将保持不变，与客户数据相关的ws2范围保持不变，ws2范围涉及
'to specific Item 2 info will change
ws1.Range（A& r）.Value = ws2.Range（A& x）.Value'订单日期* SAME
ws1。 Range（B& r）.Value = ws2.Range（B& x）.Value'Order ID * SAME
ws1.Range（C& r）.Value = ws2。范围（C& x）.Value'客户* SAME
ws1.Range（D& r）.Value = ws2.Range（D& x）.Value'Billing Add * SAME
ws1.Range（E& r）.Value = ws2.Range（E& x）.Value'Subtotal * SAME
ws1。范围（F& r）.Value = ws2.Range（F& x）.Value'Tax Amount * SAME
ws1.Range（G& r）.Value = ws2。范围（G& x）.Value'总金额* SAME
ws1.Range（H& r）.Value = ws2.Range（O& x）.Value' *改变!!!!
ws1.Range（I& r）.Value = ws2.Range（P& x）.Value'Column J * CHANGED !!!!
ws1.Range（J& r）.Value = ws2.Range（Q& x）.Value'Column K * CHANGED !!!!
ws1.Range（K& r）.Value = ws2.Range（R& x）.Value'L * CHANGED !!!!
ws1.Range（L& r）.Value = ws2.Range（S& x）.Value'Price * CHANGED !!!!
ws1.Range（M& r）.Value = ws2.Range（T& x）.Value'Attributes * CHANGED !!!!
r = r + 1'当匹配的情况下进度r和x
x = x + 1
Else
x = x + 1'仅提前x检查下一行）当没有匹配的情况时，
'ie您的输出行停留在下一行，最后写入数据
'，而x前进
结束If
循环项2结束
'只需复制第2项代码和更改适当的值匹配项目3,4,5,6等等
'您将获得项目1的所有信息的列表，按照项目的所有信息2等等，
'ie如果保罗订购了2件物品，他们不会最终在彼此之下，但是他的第二个
'项目将会更远一些，但是仍然会列在
'如果这不是你希望你以后可以排序或修改代码，但它是一个重要的改变
End Sub
I have virtually no VBA experience except that, from what I have seen other spreadsheets do, I am convinced this must be possible. I have searched all over but cannot find any explanations to help or code I can just use. I hope someone can help.
I have a download from our website cart which does not format the data how it needs to be to then up-load into some new sales order/invoice generating software.
As an example here is a link to an image that shows how the data currently looks(the workbook is called 'Orders.csv' but I can convert to xlsx if needed):
http://web225.extendcp.co.uk/fiercepc.co.uk/img1.jpg
As you can see if the customer purchases more than one product (not qty of a product, a completely different product) it is listed across the row. The first product is starts at column H, the second from column O, the third from column V and so on.
I need the data to be displayed as follows:
http://web225.extendcp.co.uk/fiercepc.co.uk/img2.jpg
So each product is listed below each other and with the same customer details before it. This is so the invoicing software can check each order ID and create an invoice accordingly showing all the different products.
I have no idea how to go about this. I guess it needs to be a looping macro that checks if a row has data in a cell and then copies ranges accordingly. Also, the macro would need to be in a different workbook (maybe called macros) so it acts on this download as it will be a new workbook each time it is downloaded. I hope this makes sense.
I'm sure this will be very easy for somebody, just not me. Please help! Ideally I need the macro with explanations so I can manipulate the ranges etc as this is only an example spreadsheet, the actual sheet is much bigger and contains more data.
I managed to get an answer to my own question from elsewere, but thought I'd share the answer with everyone who might be interested as the reply was spot on and indepth.
'****This macro is to use on sheets within the same workbook
'****If you want to transfer your data to another workbook you
'****will have to alter the code somewhat, but the idea is the same
Sub copydata()
Dim x As Integer
Dim y As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Ouput sheet") 'whatever you worksheet is
Set ws2 = Worksheets("Orders") 'or whatever your worksheet is called
'Item 1 - I'm calling the separate sections where each item ordered is in your worksheet Item 1, Item 2
'this encompasses columns H-N for item 1, etc, etc
r = 3 'this is the first row where your data will output
x = 3 'this is the first row where you want to check for data
Do Until ws2.Range("A" & x) = "" 'This will loop until column A is empty, set the column to whatever you want
'but it cannot have blanks in it, or it will stop looping. Choose a column that is
'always going to have data in it.
If Not ws2.Range("H" & x).Value = "" Then 'This checks your column H to make sure it's not empty
'If empty, it goes on to the next line, if not it copies the data.
'This column should be something that will have something in it if
'there is a product ordered for Item 1
'i.e. don't choose column J if it will have blanks where there is
'actually an item ordered
'this section copies the data, the worksheet left of the = sign is the one data will be written to
ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date
ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID
ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer
ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add
ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal
ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount
ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount
ws1.Range("H" & r).Value = ws2.Range("H" & x).Value 'Product ID
ws1.Range("I" & r).Value = ws2.Range("I" & x).Value 'Column J - couldn't read your headings for a few of these
ws1.Range("J" & r).Value = ws2.Range("J" & x).Value 'Column K
ws1.Range("K" & r).Value = ws2.Range("K" & x).Value 'L
ws1.Range("L" & r).Value = ws2.Range("L" & x).Value 'Price
ws1.Range("M" & r).Value = ws2.Range("M" & x).Value 'Attributes
r = r + 1 'Advances r and x when there is a matching case
x = x + 1
Else
x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
'i.e. your output line stays on the next line down from where it last wrote data
'while x advances
End If
Loop 'End of Item 1
'Item 2
x = 3 'this time we only define x, we want r to stay where it's at so it can continue copying the data into one
'seamless list
Do Until ws2.Range("A" & x) = "" 'still want this to stay the same
If Not ws2.Range("O" & x).Value = "" Then 'This one needs to change to match the column in your second Item
'the ranges on ws1 will stay the same, ws2 ranges pertaining to customer data stay the same, ws2 ranges pertaining
'to specific Item 2 info will change
ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date *SAME
ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID *SAME
ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer *SAME
ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add *SAME
ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal *SAME
ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount *SAME
ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount *SAME
ws1.Range("H" & r).Value = ws2.Range("O" & x).Value 'Product ID *CHANGED!!!!
ws1.Range("I" & r).Value = ws2.Range("P" & x).Value 'Column J *CHANGED!!!!
ws1.Range("J" & r).Value = ws2.Range("Q" & x).Value 'Column K *CHANGED!!!!
ws1.Range("K" & r).Value = ws2.Range("R" & x).Value 'L *CHANGED!!!!
ws1.Range("L" & r).Value = ws2.Range("S" & x).Value 'Price *CHANGED!!!!
ws1.Range("M" & r).Value = ws2.Range("T" & x).Value 'Attributes *CHANGED!!!!
r = r + 1 'Advances r and x when there is a matching case
x = x + 1
Else
x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
'i.e. your output line stays on the next line down from where it last wrote data
'while x advances
End If
Loop 'End of Item 2
'simply copy Item 2 code and change the appropriate values to match Items 3,4,5,6, etc, etc
'You will get a list of all the info for Item 1, follow by all info for Item 2, etc, etc
'i.e. if Paul orders 2 items, they won't end up right below each other, but his second
'item will end up farther down, but will still be on the list
'If this is not what you want you could sort afterwards or alter the code, but it is a significant alteration
End Sub
这篇关于循环遍历excel工作表中的行，如果单元格不为空，则复制范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
![http：/ /web225.extendcp.co.uk/fiercepc.co.uk/img2.jpg](\"http://web225.extendcp.co.uk/fiercepc.co.uk/img2.jpg\"){kind=link}
