Как программно разделить данные с помощью VBA с использованием определенной логики

Question

Это дополнение к моему предыдущему посту здесь. Код, который был ранее предоставлен мне, работал как чудо, но у меня есть проблемы, модифицирующие это, добавляя некоторую дополнительную логику.

Я создаю макрос в VBA, чтобы сделать следующее. У меня есть необработанные данные заказа, которые мне нужно преобразовать на основе некоторой логики.

Необработанные данные:

order-id      product-num     date      buyer-name  prod-name   qty-purc  sales-tax  freight  order-st
0000000000-00 10000000000000  5/29/2014 John Doe    Product 0   1         1.00       1.50     GA
0000000000-00 10000000000001  5/29/2014 John Doe    Product 1   2         1.00       1.50     GA
0000000000-00 10000000000002  5/29/2014 John Doe    Product 2   1         1.00       2.00     GA
0000000000-01 10000000000002  5/30/2014 Jane Doe    Product 2   1         0.00       0.00     PA
0000000000-01 10000000000003  5/30/2014 Jane Doe    Product 3   1         0.00       0.00     PA

Желаемый результат:

HDR 0000000000-00   John Doe    5/29/2014
CHG Tax 3.00
CHG Freight  5.00  
ITM 10000000000000  Product 0   1
ITM 10000000000001  Product 1   2
ITM 10000000000002  Product 2   1
HDR 0000000000-01   Jane Doe    5/30/2014
ITM 10000000000002  Product 2   1
ITM 10000000000003  Product 3   1

Строки "CHG" создаются на основе следующей логики; если order-st - CA или GA, добавьте сумму налога с продаж и фрахта для каждой строки с одинаковым идентификатором заказа. Если order-st НЕ CA или GA, строки CHG создавать не следует.

Буду признателен за любую помощь - дайте мне знать, если я опущу какие-либо детали!

Answer 1

Это делает это, но проверено только с данными, которые вы предоставили

Sub SortMeOut()

Dim previousOrderId As String

Dim row As Integer
row = 2


previousOrderId = Worksheets("Sheet1").Range("A2").Value

Dim offset As Integer
offset = 0

Do While (True)

        If Worksheets("Sheet1").Range("A" & row).Value = "" Then
        Exit Do
        End If

    Dim isHeader As Boolean
    isHeader = True

   Dim headerRow As Integer
    headerRow = -99 ' be a duff number to test easily

    Dim totalTax As Double
    totalTax = 0

    Dim totalFreight As Double
    totalFreight = 0

    Do While (True) 'loop through all columns with a match

        If Worksheets("Sheet1").Range("A" & row).Value <> previousOrderId Then
            Exit Do
        End If

        'Be there a value for the new thingy! If so, accumulate them
        If Worksheets("Sheet1").Range("I" & row).Value = "GA" Or Worksheets("Sheet1").Range("I" & row).Value = "CA" Then
            totalTax = totalTax + Worksheets("Sheet1").Range("G" & row).Value
            totalFreight = totalFreight + Worksheets("Sheet1").Range("H" & row).Value
        End If

        If Not isHeader Then
           Worksheets("Sheet2").Range("A" & row + 1 + offset).Value = "ITM"
            Worksheets("Sheet2").Range("B" & row + 1 + offset).Value = Worksheets("Sheet1").Range("B" & row).Value ' product num
            Worksheets("Sheet2").Range("C" & row + 1 + offset).Value = Worksheets("Sheet1").Range("E" & row).Value ' product name
            Worksheets("Sheet2").Range("D" & row + 1 + offset).Value = Worksheets("Sheet1").Range("F" & row).Value ' quantity
            End If


        If isHeader Then
        headerRow = row
            Worksheets("Sheet2").Range("A" & row + offset).Value = "HDR"
            Worksheets("Sheet2").Range("B" & row + offset).Value = Worksheets("Sheet1").Range("A" & row).Value 'order id
            Worksheets("Sheet2").Range("C" & row + offset).Value = Worksheets("Sheet1").Range("D" & row).Value ' name of the dude
            Worksheets("Sheet2").Range("D" & row + offset).Value = Worksheets("Sheet1").Range("C" & row).Value ' date

            'we also have to do the first item as well...
             Worksheets("Sheet2").Range("A" & row + 1 + offset).Value = "ITM"
            Worksheets("Sheet2").Range("B" & row + 1 + offset).Value = Worksheets("Sheet1").Range("B" & row).Value ' product num
            Worksheets("Sheet2").Range("C" & row + 1 + offset).Value = Worksheets("Sheet1").Range("E" & row).Value ' product name
            Worksheets("Sheet2").Range("D" & row + 1 + offset).Value = Worksheets("Sheet1").Range("F" & row).Value ' quantity
            isHeader = False
        End If

      row = row + 1

    Loop


'at this stage we simply insert the values, or at least, we try to. If it goes wrong, then time for tea!

If totalTax > 0 Then
headerRow = headerRow + 1
offset = offset + 1
    Range("A" & headerRow).EntireRow.Insert
    Range("A" & headerRow).Value = "CHG Tax"
    Range("B" & headerRow).Value = totalTax
End If

If totalFreight > 0 Then
    headerRow = headerRow + 1
    offset = offset + 1
    Range("A" & headerRow).EntireRow.Insert
    Range("A" & headerRow).Value = "CHG Freight"
    Range("B" & headerRow).Value = totalFreight
End If

offset = offset + 1
previousOrderId = Worksheets("Sheet1").Range("A" & row).Value


Loop

End Sub

И после запуска VBa (хотя я признаю, у меня были некоторые проблемы (не устранены), такие как количество показывает как дата (?!) но я вручную исправил это для снимка экрана).

Answer 2

После настройки решения, предоставленного @DaveRook, я наконец понял это. Я просто включил часть, которую я изменил, которая была циклами If, которые печатали строки CHG.

If totalTax > 0 Then
    offset = offset + 1
    Worksheets("Sheet2").Range("A" & headerRow + offset).EntireRow.Insert
    Worksheets("Sheet2").Range("A" & headerRow + offset).Value = "CHG Tax"
    Worksheets("Sheet2").Range("B" & headerRow + offset).Value = totalTax
End If

If totalFreight > 0 Then
    offset = offset + 1
    Worksheets("Sheet2").Range("A" & headerRow + offset).EntireRow.Insert
    Worksheets("Sheet2").Range("A" & headerRow + offset).Value = "CHG Freight"
    Worksheets("Sheet2").Range("B" & headerRow + offset).Value = totalFreight
End If

По сути, предыдущая версия не учитывала смещение значений.

Пример 1:

Пример 2: