在excel工作表中循环遍历行，如果单元格不为空，则复制范围

除了从其他电子表格所做的工作外，我几乎没有VBA的经验，我相信这一定是可能的。 我已经遍寻search，但无法find任何解释帮助或代码，我可以使用。 我希望有人能帮帮忙。

我从我们的网站购物车下载，它不会将数据格式化，然后上传到一些新的销售订单/发票生成软件。

作为一个例子，这里是一个链接到一个图像，显示了数据当前的样子（工作手册被称为“Orders.csv”，但如果需要，我可以转换为xlsx）：

http://web225.extendcp.co.uk/fiercepc.co.uk/img1.jpg

正如您所看到的，如果客户购买多个产品（不是产品的数量，是完全不同的产品），则会在行中列出。 第一个产品是从H列开始，第二个从列O开始，第三个从第V列开始，依此类推。

我需要显示的数据如下：

http://web225.extendcp.co.uk/fiercepc.co.uk/img2.jpg

所以每个产品都在下面列出，并且在它们之前具有相同的客户细节。 这样，发票软件可以检查每个订单ID，并相应地创build一个显示所有不同产品的发票。

我不知道如何去做这件事。 我想它需要一个循环的macros，检查行是否有一个单元格中的数据，然后相应地复制范围。 此外，macros需要在不同的工作簿（可能称为macros）中，因此它将作用于此下载，因为每次下载时它都将成为一个新的工作簿。 我希望这是有道理的。

我相信对某人来说这很容易，只是不是我。 请帮忙！ 理想情况下，我需要macros的解释，所以我可以操纵范围等，因为这只是一个示例电子表格，实际工作表要大得多，包含更多的数据。

Answer 1

我从别人那里设法得到了自己的问题的答案，但是我想我会和所有可能感兴趣的人分享答案，因为答复是现场和深入的。

 '****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 HN 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 'ie 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, 'ie 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, 'ie 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 'ie 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 

Answer 2

解决办法是：

1. 循环行
2. 对于每一行，获取占用列数。
3. 通过简单的math计算查找行中的订单数（假设每个产品订单都占用相同的列数）
4. 循环订购 – 将产品数据复制到新工作表中
5. 对于这些复制操作中的每一个，都将最后一个循环中正在处理的行中的客户数据复制。
6. 至于最后的要求。 在你的macros中打开工作簿orders.csv（假设文件名和位置保持不变），并执行上面提到的所有操作。

我可以为你写。 但是，如果你自己写的话，对你来说这将是一个很好的学习经验。 你将能够find大部分查询的答案（如如何获取一行中的占用列数等）在这里在stackoverflow。

另外，请通过此页面开始使用Excel VBA： http : //www.functionx.com/vbaexcel/