Присвоение цвета ячейкам Excel, где есть какое-либо значение - VBA

Формулировка задачи:

Доброго времени суток. Подскажите как можно выделить цветом заранее не определённые ячейки куда что-либо записалось (в данном случае только числовые значения) и соответственно вернуть исходный цвет при удалении значения.

Код к задаче: «Присвоение цвета ячейкам Excel, где есть какое-либо значение - VBA»

textual
Sub Выделение_изменения() 'CommandButton1_Click()
 Dim i&, A, B, Eps#
 Eps = 0.001 'точноcть отслеживания изменений числовых данных
 Dim cnt As New ADODB.Connection
 Dim cmd As ADODB.Command
 Dim prm1 As ADODB.Parameter
 Dim prm2 As ADODB.Parameter
 Dim rs As ADODB.Recordset
     cnt.ConnectionString = "Provider = SQLOLEDB.1; Persist Security Info = False; Data Source = localhost; User ID = sa; Password = proficy; Initial Catalog = Workshop"
     cnt.Open
 Set cmd = CreateObject("ADODB.Command")
     cmd.ActiveConnection = cnt
     cmd.CommandType = adCmdStoredProc
     cmd.CommandText = "dbo.EXTRACT3"
 Set prm1 = cmd.CreateParameter("@charvalue", adInteger, adParamInput, 10, TextBox1.Value)
 Set prm2 = cmd.CreateParameter("@Feature", adVarWChar, adParamInput, 50, ComboBox4.Value)
     cmd.Parameters.Append prm1
     cmd.Parameters.Append prm2
 Set rs = CreateObject("ADODB.Recordset")
     rs.CursorType = adOpenStatic
     rs.Open cmd
 If rs.EOF = True And rs.BOF = True Then
    MsgBox "Такой партии не существует"
    Exit Sub
 Else
    A = Range("G1:G100").Value
    Range("G17:G100").Clear
    Range("G17:G100").Interior.Pattern = xlNone
    ActiveSheet.Range("G17").CopyFromRecordset rs
    B = Range("G1:G100").Value
    For i = 17 To UBound(A)
        If IsNumeric(A(i, 1)) And IsNumeric(B(i, 1)) Then
          If Abs(A(i, 1) - B(i, 1)) > Eps Then Cells(i, "G").Interior.color = vbYellow
        Else
          If A(i, 1) <> B(i, 1) Then Cells(i, "G").Interior.color = vbYellow
        End If
    Next
 End If
 ComboBox4.Clear
End Sub

12   голосов, оценка 4.083 из 5


СОХРАНИТЬ ССЫЛКУ