vba 循环遍历 Excel 工作表中的行并在单元格不为空时复制一个范围

Loop through rows in an excel worksheet and copy a range if the cell isn't blank

提问by JonC

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.

我几乎没有 VBA 经验，除了从我看到的其他电子表格所做的事情之外，我相信这一定是可能的。我已经到处搜索，但找不到任何可以帮助的解释或我可以使用的代码。我希望有人能帮帮忙。

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):

作为一个例子，这里有一个图像链接，该图像显示了数据当前的外观（工作簿称为“Orders.csv”，但如果需要，我可以转换为 xlsx）：

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

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.

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

I need the data to be displayed as follows:

我需要按如下方式显示数据：

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

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.

因此，每个产品都列在彼此的下方，并且在其之前具有相同的客户详细信息。这样发票软件就可以检查每个订单 ID 并相应地创建一张发票，显示所有不同的产品。

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.

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

回答by JonC

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.

我设法从 elsewere 那里得到了我自己问题的答案，但我想我会与所有可能感兴趣的人分享答案，因为答案是准确而深入的。

'****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

回答by tumchaaditya

A solution would be:

一个解决方案是：

1. Loop through rows
2. For each rows, get number of occupied columns.
3. Find number of orders in row by simple math(assuming each product order occupies same number of columns)
4. Loop over the orders - Copy the product data in new sheet
5. For each of these copy operations, copy customer data from the row under process in outermost loop.
6. As for the last requirement. Open the workbook orders.csv(assuming the filename and location remain the same) in you macro and do all the operations mentioned above onto it.

1. 循环遍历行
2. 对于每一行，获取占用的列数。
3. 通过简单的数学计算行中的订单数（假设每个产品订单占用相同的列数）
4. 遍历订单 - 在新工作表中复制产品数据
5. 对于这些复制操作中的每一个，从最外层循环中正在处理的行复制客户数据。
6. 至于最后一个要求。在您的宏中打开工作簿 orders.csv（假设文件名和位置保持不变）并对其执行上述所有操作。

I can write it for you. But, it would be a good learning experience for you if you write it on your own. You will able find answers to most of your queries(like how to get number of occupied columns in a row etc.) here on stackoverflow.

我可以写给你。但是，如果您自己编写，这对您来说将是一次很好的学习体验。您可以在 stackoverflow 上找到大多数查询的答案（例如如何获取一行中占用的列数等）。

Also, go through this page to get started on Excel VBA: http://www.functionx.com/vbaexcel/

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