Этот макрос предназначен для поиска значения в столбце c в книге с именем job mmrf, где оно совпадает с книгой U100 Информация о материале. Он тянет цены и время выполнения заказа со второй рабочей книги (U100) до первой рабочей книги (Job MMRF). Если ячейка в столбце c не имеет значения, предполагается, что шрифт столбца A станет красным. Кроме того, там, где цены и время выполнения заказа, будет указано «Необходимо связаться с продавцом». Этот фрагмент кода является мерой, которую мы приняли, чтобы изменить цвет и поместить слово, но он работает неправильно. Я подозреваю, что что-то не так с выбранным делом. Я не знаю, почему это не работает, вы можете помочь мне найти, что не так.
' If no value
Select Case True
Case 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"
Если в столбце c нет значения, предполагается, что смещение -2 делает текст красным, а смещение 9 и 10, чтобы в столбце говорилось о необходимости связаться с поставщиком.
Когда я запускаю код, он делает текст в столбце -2 зеленым и вытягивает случайные значения для столбцов 9 и 10. Я не знаю, откуда эти ценности.
Это весь код VB, который мы используем, если это поможет найти причину проблемы.
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 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"
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
End Select
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
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
Большое спасибо за прочтение, надеюсь, вы поможете мне найти, что не так с проблемой изменения цвета.