Есть ли способ условно отформатировать ячейки, если они связаны формулой в другой ячейке? - PullRequest
Новая
       8

Есть ли способ условно отформатировать ячейки, если они связаны формулой в другой ячейке?

0 голосов
/ 27 декабря 2018

На первом листе у меня есть описания в столбце A и значения в столбце B. На втором листе у меня есть формулы в столбцах A-F, которые я вручную заполняю значениями из первого столбца B на основе того, что в описаниистолбец А есть.Я хочу выделить ячейки на листе один столбец B, если рассматриваемая ячейка уже использовалась в формуле на листе два.Если возможно, используйте условное форматирование, иначе используйте макрос.

Я хочу иметь возможность быстро увидеть, была ли ячейка в столбце B уже добавлена ​​в формулу на другом листе, чтобы случайно не включить значениедважды. 

  Sheet One               Sheet Two
     A     B     C           A     B     C
1  salt    3            1       =B1+B4
2  base    3            2
3  base    4            3
4  salt    1            4             =B2+B3
5  base    4            5

Я ожидаю, что смогу автоматически выделить ячейку, уже находящуюся в другой функции, без необходимости делать это вручную, чтобы уменьшить вероятность ошибки.В приведенном выше примере ячейки с B1 по B4 будут выделены, так как они использовались в формуле, а B5 останется нормальным, поскольку они еще не использовались

1 Ответ

0 голосов
/ 27 декабря 2018

VBA. Условное форматирование.Объединение массива и диапазона

Функции

  • Метод поиска ( SO )
  • Свойство Cells
  • Родительское свойство
  • Свойство формулы
  • Метод изменения размера
  • Функция InStr
  • Замена функции
  • Метод объединения

код 

Sub CompareColumnWithRange()

  Const cStrTgtWs As Variant = 1        ' Target Worksheet Name/Index
  Const cStrSrcWs As Variant = 2        ' Source Worksheet Name/Index
  Const cLngTgtFirst As Long = 1        ' Target First Row
  Const cLngSrcFirst As Long = 1        ' Source First Row
  Const cStrTgtColumn As Variant = "B"  ' Target Column Letter/Number
  Const cStrSrcRange As String = "A:F"  ' Source Columns Range
  Const cColor As Long = 255            ' Formatting Color

  Dim rngTgt As Range                   ' Target Range
  Dim rngU As Range                     ' Target Union Range
  Dim vntSrc As Variant                 ' Source Array
  Dim i As Long                         ' Source Array Row Counter
  Dim j As Integer                      ' Source Array Column Counter
  Dim k As Long                         ' Target Range Row Counter

  With Worksheets(cStrSrcWs).Range(cStrSrcRange)
    ' Check if sheet is empty (No data).
    If .Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
        Is Nothing Then Exit Sub
    ' Paste Source Range's formulas into Source Array. Since the previous
    ' With statement refers to a range, the Parent property has to be used
    ' to 'aquire sheet level'.
    vntSrc = .Parent.Range(.Parent.Cells(cLngSrcFirst, .Column), _
        .Parent.Cells(.Cells.Find("*", , , , , 2).Row, _
        .Columns.Count - .Column + 1)).Formula
  End With

'  ' Print contents of vntSrc to Immediate window.
'  For i = 1 To UBound(vntSrc)
'    For j = 1 To UBound(vntSrc, 2)
'      Debug.Print vntSrc(i, j)
'    Next
'  Next

  ' Target Column vs Source Array
  With Worksheets(cStrTgtWs)
    ' Determine the Target Range (1 column).
    Set rngTgt = .Cells(cLngTgtFirst, cStrTgtColumn).Resize( _
        .Cells(.Rows.Count, cStrTgtColumn).End(xlUp).Row - cLngTgtFirst + 1)
    ' Loop through Target Range (1 column)
    For k = cLngTgtFirst To .Cells(.Rows.Count, cStrTgtColumn).End(xlUp).Row
      ' Loop through Source Array rows.
      For i = 1 To UBound(vntSrc)
        ' Loop through Source Array columns.
        For j = 1 To UBound(vntSrc, 2)
          ' Search for Target Range's cell address in current value
          ' of Source Array i.e. remove the $ signs in both, and add
          ' sheet name for Target Range.
          If InStr(1, Replace(vntSrc(i, j), "$", ""), .Name & "!" _
              & Replace(.Cells(k, cStrTgtColumn).Address, "$", "")) <> 0 Then
            If Not rngU Is Nothing Then ' Add cells to existing range.
              Set rngU = Union(rngU, .Cells(k, cStrTgtColumn))
             Else ' Add cells to non-existing range. Runs only the first time.
              Set rngU = .Cells(k, cStrTgtColumn)
            End If
            Exit For  ' If a value has been found, stop searching for more.
          End If
        Next
      Next
    Next
  End With

  ' Apply formatting to all 'collected' cells in Target Union Range in one go.
  If Not rngU Is Nothing Then
    rngU.Interior.Color = cColor
    Set rngU = Nothing
  End If

  Set rngTgt = Nothing

End Sub
...