Условная окраска данной ячейки с использованием VBA, основанная на нескольких критериях из других ячеек / рабочих таблиц - PullRequest
0 голосов
/ 23 мая 2019

Я пытаюсь условно раскрасить кучу ячеек на Tab1. Я использую данные из столбца на вкладке Tab2, а также из столбца на вкладке Tab3, чтобы попытаться сопоставить их с заданными переменными ячейки.

Основная логика: Если есть совпадение с ячейкой в ​​столбце B таблицы Tab2, проверьте значение в столбце E той же строки на вкладке Tab2.

Если это значение в столбце E больше нуля в Tab2, то раскрасьте начальное значение ячейки в диапазоне поиска на Tab1 по цвету ... но если я тоже существую на Tab3, то покрасьте что-нибудь другое.

Копирование и вставка частей кода. Это взорванная «нерабочая» версия кода. Чтобы бежать, нужно вечно, если он бежит.

For Each cellValue In mainRng2

‘if I do not exist in SerializedInvtLocations, but do exist in NonSerializedInventory then check the value in cell E is greater than zero. 
   If VBA.IsError(Application.match(cellValue, Sheets("SerializedInvtLocations").Range("A2:A" & lngLastRowSer), 0)) And Not VBA.IsError(Application.match(cellValue, Sheets("NonSerializedInventory").Range("B2:B" & lngLastRowNon), 0)) Then


    For Each cell In Sheets("NonSerializedInventory").Range("B2:B" & lngLastRowNon)

        x = x + 1
         checker = Application.WorksheetFunction.VLookup(cellValue, Range("B" & x), 1, False)

         'if the vlookup value in B2
         If (checker = cellValue) Then
        'i exist in non-serialized list, do I have a quant > 0?

            quant = Application.WorksheetFunction.VLookup(cellValue, Range("E" & x), 1, False)

            If quant >= 1 Then
                     cellValue.Interior.ColorIndex = 8 'teal
                     ‘Sheets("Serialized and Non-Serialized").Range(cell.Address).Interior.Color = RGB(0, 255, 0)
                   ‘   Debug.Print "Checker value is: " & checker & " and " & cell.Address & "/" & cell.Value

                   i3 = i3 + 1 ‘ counter

            Else
                       cellValue.Interior.ColorIndex = 15 'gray

           End If
          End If
    Next cell
   End If

Next cellValue

В настоящее время файл просто зависает и не дает результатов (или это заняло более 40 минут, и я просто вышел). Если я изменю код и изменит ситуацию - я МОГУ получить результаты, но они не точны.

EDIT: Еще одна попытка:

If inSer = cellValue.Value And inNon = cellValue.Value Then
    If inNonQuan >= 1 Then
    cellValue.Interior.ColorIndex = 46
    Else
    cellValue.Interior.ColorIndex = 4
    End If
End If
If inSer <> cellValue.Value And inNon = cellValue.Value Then
    If inNonQuan >= 1 Then
    cellValue.Interior.ColorIndex = 8
    Else
    cellValue.Interior.ColorIndex = 15
    End If
 End If
If inSer = cellValue.Value And inNon <> cellValue.Value Then
    cellValue.Interior.ColorIndex = 4
End If
If inSer <> cellValue.Value And inNon <> cellValue.Value Then
    cellValue.Interior.ColorIndex = 15
End If

Ответы [ 2 ]

0 голосов
/ 17 июня 2019

Мое решение было неутешительно простым - VLookup возвращает только первый экземпляр совпадающего значения, а не все последующие значения.Вместо vlookup я должен был просто «суммировать» значения столбца, чтобы получить что-либо больше нуля.

0 голосов
/ 24 мая 2019

Вы должны быть в состоянии сделать что-то с этим:

Sub Tester()

    Dim c As Range, mainRng2 As Range, t2q As Variant, t3m As Boolean, Tab2, Tab3, wb

    Set wb = ActiveWorkbook 'or ThisWorkbook ?
    Set Tab2 = wb.Worksheets("Tab2")
    Set Tab3 = wb.Worksheets("Tab3")

    Set mainRng2 = wb.Worksheets("Tab1").Range("A2:A1000") 'for example

    For Each c In mainRng2

        'quantity on Tab2 from colE, based on ColB match
        '  will be an error value if no match found
        t2q = Application.VLookup(c.Value, Tab2.Range("B:E"), 4, False)

        'any match on Tab3 ColA ?
        t3m = Not IsError(Application.Match(c.Value, Tab3.Range("A:A"), 0))

        'did we get a quantity from Tab2 (was there any match)?
        If Not IsError(t2q) Then
            If t2q >= 1 Then
                '15 if also a match on tab3, else 8
                c.Interior.ColorIndex = IIf(t3m, 15, 8)
            End If
        End If

    Next c

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