Обновление цен из мастер-списка через рабочую книгу VBA

Question

У меня есть лист основной цены (цена теста) с названием продукта (столбец A) и ценой (столбец B).Я хочу создать макрос, который при нажатии на кнопку будет обновлять цены по всей книге.Предыдущий человек на моей должности уже создал мод, который будет обновлять цены по всему WB, если он будет изменен в одной WS.Я пытаюсь связать основной список с этим кодом.Так что просматривайте список и обновляйте один лист, который будет использовать существующий мод для обновления всех остальных листов.Может кто-нибудь помочь с этим?

Это код, который обновляет листы, мне нужно связать основной прайс-лист с этим:

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

Answer 1

Вы можете создать словарь значений и затем передать словарь в модуль. Вам потребуется добавить цикл «Для каждого» на свой мастер-лист, чтобы найти строку с продуктом для каждого конкретного листа.

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

Тогда ваша Sub ChangePrice будет выглядеть примерно так:

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

Большой ресурс для изучения входов и выходов словарей можно найти здесь .