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

Question

我在工作表{{1}中有一个OrderForm，在工作表OrderForm中有一个表OrderTable看起来像这样：

现在，一个customerID可以一种形式提交的最大产品数量为3，该列表来自OrderData的数据验证。

我的目标是每次提交productlist时，该记录就会自动作为新行添加到OrderForm中。

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

例如，如果此客户ID为151A，并且他或她订购了蓝莓= 15，苹果= 20和李子= 5，那么我希望将这些金额存储在OrderTable中，作为客户151A的新记录，其金额相应地位于匹配列的名称下。

这是我目前正在尝试的代码，但是我无法弄清楚匹配查找部分：

OrderTable

有人知道如何处理这个问题吗？谢谢！

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

Answer 2

您可以使用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 3

您可以为该行设置一个公式以获取数据，然后用值覆盖它。

我还建议您命名范围，以使其更易于检索值。

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