通过工作簿VBA从主列表更新价格

Posted 2021-03-27

我有一个主价格工作表（测试价格），产品名称（col A）和价格（col B）。我想创建一个宏，当您单击一个按钮时，它将通过整个工作簿更新价格。在我的位置上的前一个人已经创建了一个MOD，如果在一个WS中更改了它，将在整个WB中更新价格。我试图将主列表链接到该代码。因此，循环遍历列表并更新一张将使用现有mod更新所有其他工作表的工作表。任何人都可以帮忙吗？

这是更新工作表的代码，我需要将主价格表链接到此：

Sub ChangePrice(row As String, price As String)

    Dim cropVal As String: cropVal = Cells(row, 2).Value ' inefficient
    Dim LastRow As Long
    For Each ws In ActiveWorkbook.Worksheets

        'simple check for division in A3 (stronger check may be needed)
        If ws.Cells(3, 1).Value = "Division:" Then

            LastRow = ws.Range("A" & Rows.count).End(xlUp).row

            ' starts in row 12, though data starts in 13
            For i = 12 To LastRow

                'check column 2 if crop is the same
                If ws.Cells(i, 2).Value = cropVal Then

                    'if so, change its price in column 10
                    ws.Cells(i, 10).Value = price

                'this handles situations where the symbol is attached
                ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then

                    ws.Cells(i, 10).Value = price

                End If


            Next i


        End If
    Next ws

End Sub

答案

您可以创建值的字典，然后将字典传递给模块。您需要在主工作表中添加For Each循环，以便为每个特定工作表查找包含产品的行。

Sub CropValFind()
Dim ProdCol As Range, Cell As Range, PriceCol As Range
Set ProdCol = 'Your product column range here
Set PriceCol = 'Your Price Column range here
For Each Cell in ProdCol
    Call ChangePrice(Cell.Value, CreateDictFromColumns("MasterSheetName", ProdCol.Column, PriceCol.Column))
Next
End Sub

假设您的产品和价格列彼此相邻且值为字符串：

从https://stackoverflow.com/a/33523909/10462532拉出来

Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary
    Set CreateDictFromColumns = New Dictionary
    Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)
    Dim i As Long
    Dim lastCol As Long '// for non-adjacent ("A:ZZ")
    lastCol = rng.Columns.Count
    For i = 1 To rng.Rows.Count
        If (rng(i, 1).Value = "") Then Exit Function
        CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value
    Next
End Function

然后你的ChangePrice Sub看起来像这样。

Sub ChangePrice(row As String, price As Dictionary)
Dim cropVal As String: cropVal = row 
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets

'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then

    LastRow = ws.Range("A" & Rows.count).End(xlUp).row

    ' starts in row 12, though data starts in 13
    For i = 12 To LastRow

        'check column 2 if crop is the same
        If ws.Cells(i, 2).Value = cropVal Then

            'if so, change its price in column 10
            ws.Cells(i, 10).Value = price(row)

        'this handles situations where the symbol is attached
        ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then

            ws.Cells(i, 10).Value = price(row)

        End If


    Next i


End If
Next ws
End Sub

可以找到一个很好的资源来学习词典的来龙去脉qazxsw poi。