VBA ищет данные в книгах

Question

Я работаю аналитиком данных для запуска программного обеспечения, где мне нужно писать макросы для более эффективного анализа и сортировки данных. В настоящее время я работаю над макросом, который берет одну рабочую книгу со значением ("MMRF задания") и ищет ее в другой ("Информация о материале U100"). Мой код выглядит следующим образом:

Sub MMRFValidation()

Dim c As Range
Dim leadtime As Double
Dim price As Double

Application.ScreenUpdating = False

With Workbooks("Job MMRF.csv")
    For Each c In Range("C:C")
        If c.Value = "" Then
            c.Offset(, -2).Font.Color = vbRed
            c.Offset(, 9).Value = "Need to contact vendor"
            c.Offset(, 10).Value = "Need to contact vendor"
        Else

            Dim a As Range

            With Workbooks("U100 Material Information.xlsx")
                For Each a In Range("A:A")
                    If a.Value = c.Value Then
                        price = a.Offset(, 15).Value
                        leadtime = a.Offset(, 13).Value
                    End If
                Next a
            End With

            If price = 0.01 And leadtime = 21 Then
                c.Offset(, -2).Font.ColorIndex = 7
                c.Offset(, 9).Value = leadtime
                c.Offset(, 10).Value = price
            Else
                c.Offset(, -2).Font.Color = vbGreen
                c.Offset(, 9).Value = leadtime
                c.Offset(, 10).Value = price
            End If
        End If
    Next c
End With

Application.ScreenUpdating = True

End Sub

c - это значение из первой книги. Я пытаюсь найти c во второй книге. Если он найден, я хочу скопировать значения из 13-го и 15-го столбца в U100 wb (связанные со строкой, где была найдена c) и вставить эти значения в 9-ю и 10-ю строку в JobMMRF (связанной со строкой где c изначально был). Часть кода, которая меняет цвет шрифта, работает, а часть цены / времени выполнения - нет. Пожалуйста, помогите, спасибо.

редактировать: я обновил код. Теперь он получает значения цены и времени выполнения заказа, но по какой-то причине они всегда равны 0.

Пример данных

Answer 1

Я реорганизовал ваш код.

Прочитайте комментарии и настройте его в соответствии с вашими потребностями

РЕДАКТИРОВАТЬ: Я изменил способ обработки случаев, когда значение ячейки CSV отличается от пустой строки.

Код:

Sub MMRFValidation()

    Dim csvWorkbook As Workbook
    Dim csvSheet As Worksheet
    Dim csvRange As Range
    Dim csvcell As Range

    Dim csvLastRow As Long

    Dim materialWorkbook As Workbook
    Dim materialSheet As Worksheet
    Dim materialRange As Range
    Dim materialCell As Range

    Dim materialLastRow As Long

    Dim leadtime As Double
    Dim price As Double

    Application.ScreenUpdating = False

    ' Adjust workbook and worksheet names
    Set csvWorkbook = Workbooks("Job MMRF.csv")

    Set csvSheet = csvWorkbook.Worksheets("CSV SHEET NAME") ' <- ADJUST SHEET NAME

    Set materialWorkbook = Workbooks("U100 Material Information.xlsx")

    Set materialSheet = materialWorkbook.Worksheets("MATERIAL SHEET NAME") ' <- ADJUST SHEET NAME

    ' This looks for the last row in column C
    csvLastRow = csvSheet.Cells(csvSheet.Rows.Count, "C").End(xlUp).Row

    ' This looks for the last row in column A
    materialLastRow = materialSheet.Cells(materialSheet.Rows.Count, "A").End(xlUp).Row

    ' Set the range from C1 to last row
    Set csvRange = csvSheet.Range("C1:C" & csvLastRow)
    Set materialRange = materialSheet.Range("A1:A" & materialLastRow)

    ' Loop through each cell in target range
    For Each csvcell In csvRange.Cells

        ' If no value
        Select Case True
        Case Trim(csvcell.Value) = vbNullString
            csvcell.Offset(, -2).Font.Color = vbRed
            csvcell.Offset(, 9).Value = "Need to contact vendor"
            csvcell.Offset(, 10).Value = "Need to contact vendor"

            ' Reset if null?
            price = 0
            leadtime = 0
        Case Else
            ' Get matching cell in material workbook
            Set materialCell = GetMatchedCell(materialRange, csvcell.Value)

            ' If found
            If Not materialCell Is Nothing Then
                price = materialCell.Offset(, 15).Value
                leadtime = materialCell.Offset(, 13).Value
            Else
            ' Reset if not?
                price = 0
                leadtime = 0
            End If

            ' Moved this to only the cases where the csvcell value is different than null
            With csvcell

                If price = 0.01 And leadtime = 21 Then
                    .Offset(, -2).Font.ColorIndex = 7
                    .Offset(, 9).Value = leadtime
                    .Offset(, 10).Value = price
                Else
                    .Offset(, -2).Font.Color = vbGreen
                    .Offset(, 9).Value = leadtime
                    .Offset(, 10).Value = price
                End If

            End With

        End Select

    Next csvcell

    Application.ScreenUpdating = True

End Sub

Private Function GetMatchedCell(ByVal lookupRange As Range, ByVal lookupValue As Variant) As Range

    Dim lookupCell As Range

    For Each lookupCell In lookupRange.Cells

        If lookupCell.Value = lookupValue Then
            Set GetMatchedCell = lookupCell
            Exit For
        End If

    Next lookupCell

End Function

Дайте мне знать, если это работает