Excel VBA вставляет строки под столбцом, если значение соседней ячейки соответствует именам столбца

Question

У меня есть OrderForm в листе OrderForm и таблица OrderTable в листе OrderData, которая выглядит следующим образом:

Теперь максимальный продуктЧисло, которое один идентификатор клиента может предоставить в одной форме, равно 3, а список составлен на основе проверки данных из productlist.

Моя цель состоит в том, чтобы каждый раз при отправке OrderForm запись автоматически добавлялась как новая строка в OrderTable.

Теперь проблема в том, как мне сохранить введенную сумму для этого заказа в столбце, где имя столбца соответствует продукту, введенному в M9: M11?

Так, например, еслиэтот идентификатор клиента - 151A, и он или она заказали Blueberry = 15, Apple = 20 и Plum = 5, тогда я бы хотел, чтобы эти суммы были сохранены в OrderTable как новая запись для клиента 151A, с суммами подсоответствующие имена столбцов соответственно.

Это мой код, который я сейчас пробую, но я не могу понять часть поиска соответствия:

Sub Submit_OrderForm()
Dim ws As Worksheet
Dim LastRow As Long

Set ws = Worksheets("OrderData")

LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

customerid = Sheets("OrderForm").Range("N6").Value

  'This is where I'm stuck. If column header matches the product chosen, Then:
    ws.Range("C:H").Value = Worksheets("OrderForm").Range("N9").Value  'Product 1
    ws.Range("C:H").Value = Worksheets("OrderForm").Range("N10").Value   'Product 2
    ws.Range("C:H").Value = Worksheets("OrderForm").Range("N11").Value  'Product 3
    End If

End Sub

Кто-нибудь знает, как с этим справитьсяпроблема?Спасибо!

Answer 1

Вы можете использовать Find() метод Range объекта и проходить через фактический ввод продукта:

Sub Submit_OrderForm()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim customerID As Variant

    Set ws = Worksheets("OrderData")

    With Worksheets("OrderForm")
        customerID = .Range("N6").Value
        If IsEmpty(customerID) Then Exit Sub ' exit if no customer input
        If WorksheetFunction.CountA(.Range("M9:M11")) = 0 Then Exit Sub ' exit if no products input

        lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1 'finds the last blank row in OrderData data

        ws.Cells(lastRow, 2).Value = customerID ' write customer Id
        Dim cell As Range
        For Each cell In .Range("M9:M11").SpecialCells(xlCellTypeConstants) ' loop through products actual input
            ws.Cells(lastRow, ws.Range("C4:H4").Find(What:=cell.Value2, LookIn:=xlValues, lookat:=xlWhole).Column) = cell.Offset(, 1).Value
        Next
    End With
End Sub

Answer 2

Вы можете задать формулу для строки, чтобы получить данные, а затем перезаписать ее значением.

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

Sub Submit_OrderForm()
    Dim ws As Worksheet, os as Worksheet
    Dim LastRow As Long

    Set os = WorkSheets("OrderForm")
    Set ws = Worksheets("OrderData")
    LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the next blank row

    ws.Range(LastRow, "B").Value = os.Range("N6")
    With ws.Range(LastRow, "C").Resize(,6)
        .Formula = "=IFERROR(VLOOKUP(C4,'OrderData'!$M$9:$N$11,2,FALSE),"""")"
        .Value = .Value
    end with
End Sub

Answer 3

Следующие результаты достигнут ожидаемых результатов, он будет использовать метод .Find для сопоставления столбцов с введенными продуктами, а затем использует их для добавления значений:

Sub Submit_OrderForm()
Dim ws As Worksheet: Set ws = Worksheets("OrderData")
Dim wsOrderForm As Worksheet: Set wsOrderForm = Worksheets("OrderForm")
Dim LastRow As Long

LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

Set Product1 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M9").Value, lookat:=xlWhole)
'find the column that matches the first product
Set Product2 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M10").Value, lookat:=xlWhole)
Set Product3 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M11").Value, lookat:=xlWhole)

ws.Cells(LastRow, "B").Value = wsOrderForm.Range("N6").Value
ws.Cells(LastRow, Product1.Column).Value = wsOrderForm.Range("N9").Value
ws.Cells(LastRow, Product2.Column).Value = wsOrderForm.Range("N10").Value
ws.Cells(LastRow, Product3.Column).Value = wsOrderForm.Range("N11").Value
End Sub

ОБНОВЛЕНИЕ:

Если вы хотите, чтобы одни и те же клиенты были добавлены в одну строку, это будет достигнуто следующим:

Sub Submit_OrderForm()
Dim ws As Worksheet: Set ws = Worksheets("OrderData")
Dim wsOrderForm As Worksheet: Set wsOrderForm = Worksheets("OrderForm")
Dim LastRow As Long

LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

customerid = wsOrderForm.Range("N6").Value

Set customerfound = ws.Range("B:B").Find(What:=customerid, lookat:=xlWhole)
Set Product1 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M9").Value, lookat:=xlWhole)
Set Product2 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M10").Value, lookat:=xlWhole)
Set Product3 = ws.Range("C4:H4").Find(What:=wsOrderForm.Range("M11").Value, lookat:=xlWhole)

If Not customerfound Is Nothing Then
    ws.Cells(customerfound.Row, Product1.Column).Value = ws.Cells(customerfound.Row, Product1.Column).Value + wsOrderForm.Range("N9").Value
    ws.Cells(customerfound.Row, Product2.Column).Value = ws.Cells(customerfound.Row, Product1.Column).Value + wsOrderForm.Range("N10").Value
    ws.Cells(customerfound.Row, Product3.Column).Value = ws.Cells(customerfound.Row, Product1.Column).Value + wsOrderForm.Range("N11").Value
Else
    ws.Cells(LastRow, "B").Value = customerid
    ws.Cells(LastRow, Product1.Column).Value = ws.Range("N9").Value
    ws.Cells(LastRow, Product2.Column).Value = ws.Range("N10").Value
    ws.Cells(LastRow, Product3.Column).Value = ws.Range("N11").Value
End If
End Sub