VBA Select Case проблема (не работает правильно) - PullRequest
0 голосов
/ 02 марта 2020

Этот макрос предназначен для поиска значения в столбце 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

Большое спасибо за прочтение, надеюсь, вы поможете мне найти, что не так с проблемой изменения цвета.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...