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

Question

我在 sheet OrderForm 中有一个 OrderForm，在 Sheet OrderData 中有一个 table OrderTable 看起来像这样：

现在一个customerID在一个表单中最多可以提交3个商品，列表来自productlist的数据验证。

我的目标是每次提交 OrderForm 时，记录都会自动添加为 OrderTable 中的新行。

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

因此，例如，如果此客户 ID 为 151A，并且他或她订购了 Blueberry=15、Apple=20 和 Plum=5，那么我希望将这些金额存储在 int 中 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 方法将列与输入的产品匹配，然后使用它们的列添加值：

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

您可以使用 Range 对象的 Find() 方法并循环实际产品输入：

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:$N,2,FALSE),"""")"
        .Value = .Value
    end with
End Sub

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

Excel VBA insert rows under the column if adjacent cell value matches column names

excel

vba

excel-2010