循环遍历Excel工作表中的行,如果单元格不为空,则复制范围

时间:2012-06-07 14:02:48

标签: excel vba excel-vba while-loop

我几乎没有VBA经验,只是从我看到的其他电子表格来看,我确信这一定是可能的。我已经搜索了所有但无法找到任何解释来帮助或我可以使用的代码。我希望有人可以提供帮助。

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

这里的示例是指向图像的链接,该图像显示当前数据的外观(工作簿称为“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并创建相应的发票,显示所有不同的产品。

我不知道如何解决这个问题。我想它需要是一个循环宏,检查一行是否有单元格中的数据,然后相应地复制范围。此外,宏需要在不同的工作簿(可能称为宏)中,因此它会对此下载起作用,因为每次下载时它都是新的工作簿。我希望这是有道理的。

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

2 个答案:

答案 0 :(得分:2)

我设法从其他地方得到了我自己的问题的答案,但我想我会与所有可能感兴趣的人分享答案,因为答案是深入和深入的。

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

答案 1 :(得分:0)

解决方案是:

  1. 循环遍历行
  2. 对于每一行,获取占用列数。
  3. 通过简单的数学计算行中的订单数量(假设每个产品订单占用相同的列数)
  4. 循环订单 - 在新工作表中复制产品数据
  5. 对于每个复制操作,从最外层循环中的进程中的行复制客户数据。
  6. 至于最后一项要求。在宏中打开工作簿orders.csv(假设文件名和位置保持不变)并执行上面提到的所有操作。
  7. 我可以为你写。但是,如果您自己编写,那对您来说将是一次很好的学习经历。您可以在stackoverflow上找到大多数查询的答案(比如如何获取一行中的占用列数等)。

    另外,请浏览此页面以开始使用Excel VBA: http://www.functionx.com/vbaexcel/