Excel - Invoice Export重组以输入quickbooks

时间:2015-12-09 22:48:03

标签: excel-vba vba excel

我有一张从我​​们的POS导出的Excel表格。我需要将其重新格式化为适合快速书的输入格式。

Quote No    Delivery Date   Patient Line 1  Price 1 Line 2  Price 2 Line 3  Price 3 Line 4  Price 4 Line 5  Price 5 Line 6  Price 6 Line 7  Price 7 Line 8  Price 8 Line 9  Price 9 Line 10 Price 10    Line 11 Price 11    Line 12 Price 12    Line 13 Price 13    Line 14 Price 14    Line 15 Price 15    Line 16 Price 16    Line 17 Price 17    Line 18 Price 18    Line 19 Price 19    Line 20 Price 20    Line 21 Price 21    Line 22 Price 22    Line 23 Price 23    Line 24 Price 24    Total
1234        10/10/15        ABC     p1l     $1.00   p2l      $1.00                                                  p1r     $1.00   p2r     $1.00                                                                                                                                                                                                                                                                                                                                               $4.00

我需要发生的是每条线和价格都是新线,例如

Quote No   Delivery Date    Patient     Product     Price     Total
1234       10/10/15         ABC         P1L         $1.00     $4.00
1234       10/10/15         ABC         P2L         $1.00     $4.00
1234       10/10/15         ABC         P1R         $1.00     $4.00
1234       10/10/15         ABC         P2R         $1.00     $4.00
.....
2222       10/15/15         YZD        ..............................

因此,对于发票上的每个产品,我需要创建一个新行,其中包含重复的客户信息以及总计。

产品/价格组合有24个可用的插槽,其中许多通常是空白的,其他填充的产品/价格组合之间将有空白的产品/价格组合,因为POS将特定的销售项目放在特定的列而不是所有销售包含所有项目。因此,对于那些空白点,我们无法创建空白行。

列的范围是A:AZ

它不会超过1000行

希望这不是太多问题。

由于

1 个答案:

答案 0 :(得分:0)

I have written a VBA function which should do as you describe. The function checks every cell in the used range to see if it is not empty and below a header that contains 'line'. If the cell does contains this data, it takes the relevant data and puts it into a new sheet named ws temporarily. Once all the data is tranferred it deletes the original sheet and renames the the sheet to be the same as the original, giving the impression of a modified sheet. I haven't been able to test it extensively but it should work. The function is as follows:

    Function NormalizeData(shtnm As String)
        Application.ScreenUpdating = False
        Dim rowcount As Long
        Dim colcount As Long
        Dim colnum As Long
        Dim rownum As Long
        Dim tgtrow As Long
        Sheets.Add.Name = "ws"
        Dim ws As Worksheet
        Set ws = Sheets("ws")
        ws.Cells(1, 1).Value = "Quote No"
        ws.Cells(1, 2).Value = "Delivery Date"
        ws.Cells(1, 3).Value = "Patient"
        ws.Cells(1, 4).Value = "Product"
        ws.Cells(1, 5).Value = "Price"
        ws.Cells(1, 6).Value = "Total"
        With Sheets(shtnm)
        rowcount = .UsedRange.Rows.Count
        colcount = .UsedRange.Columns.Count
        For rownum = 2 To rowcount
            For colnum = 1 To colcount
                tgtrow = ws.UsedRange.Rows.Count + 1
                If .Cells(1, colnum) Like "*Line *" And .Cells(rownum, colnum) <> "" Then
                        ws.Cells(tgtrow, 1).Value = .Cells(rownum, 1).Value
                        ws.Cells(tgtrow, 2).Value = .Cells(rownum, 2).Value
                        ws.Cells(tgtrow, 3).Value = .Cells(rownum, 3).Value
                        ws.Cells(tgtrow, 4).Value = .Cells(rownum, colnum).Value
                        ws.Cells(tgtrow, 5).Value = .Cells(rownum, colnum + 1).Value
                        ws.Cells(tgtrow, 6).Value = .Cells(rownum, colcount).Value
                End If
            Next colnum
        Next rownum
        .Delete
        End With
        ws.Name = shtnm
        Application.ScreenUpdating = True
    End Function

This is the sub to call the tranformation:

    Sub CallNormalise()
        Application.DisplayAlerts = False
        Call NormalizeData("Sheet1")
    End Sub

Good luck!