excel - 如果相邻单元格值与列名匹配，则 Excel VBA 在列下插入行

Question

我有一个OrderFormin sheet OrderForm，并且OrderTable在 SheetOrderData中有一个表格，如下所示：

现在一个customerID可以在一个表单中提交的最大产品编号为3，并且该列表来自productlist.

我的目标是每次OrderForm提交 an 时，记录都会自动添加为OrderTable.

现在的问题是，如何将输入的订单金额存储在列名与 M9:M11 中输入的产品匹配的列中？

例如，如果这个客户 ID 是 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

任何人都知道如何处理这个问题？谢谢！

标签： excelvbaexcel-2010

Answer 1

以下将达到您的预期结果，它将使用 .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