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

Узнай цену своей работы

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

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

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

textual
Листинг программы
  1. Sub Выделение_изменения() 'CommandButton1_Click()
  2. Dim i&, A, B, Eps#
  3.  Eps = 0.001 'точноcть отслеживания изменений числовых данных
  4. Dim cnt As New ADODB.Connection
  5.  Dim cmd As ADODB.Command
  6.  Dim prm1 As ADODB.Parameter
  7.  Dim prm2 As ADODB.Parameter
  8.  Dim rs As ADODB.Recordset
  9.      cnt.ConnectionString = "Provider = SQLOLEDB.1; Persist Security Info = False; Data Source = localhost; User ID = sa; Password = proficy; Initial Catalog = Workshop"
  10.      cnt.Open
  11.  Set cmd = CreateObject("ADODB.Command")
  12.      cmd.ActiveConnection = cnt
  13.      cmd.CommandType = adCmdStoredProc
  14.      cmd.CommandText = "dbo.EXTRACT3"
  15.  Set prm1 = cmd.CreateParameter("@charvalue", adInteger, adParamInput, 10, TextBox1.Value)
  16.  Set prm2 = cmd.CreateParameter("@Feature", adVarWChar, adParamInput, 50, ComboBox4.Value)
  17.      cmd.Parameters.Append prm1
  18.      cmd.Parameters.Append prm2
  19.  Set rs = CreateObject("ADODB.Recordset")
  20.      rs.CursorType = adOpenStatic
  21.      rs.Open cmd
  22.  If rs.EOF = True And rs.BOF = True Then
  23.     MsgBox "Такой партии не существует"
  24.     Exit Sub
  25.  Else
  26.     A = Range("G1:G100").Value
  27.     Range("G17:G100").Clear
  28.     Range("G17:G100").Interior.Pattern = xlNone
  29.     ActiveSheet.Range("G17").CopyFromRecordset rs
  30.     B = Range("G1:G100").Value
  31.     For i = 17 To UBound(A)
  32.         If IsNumeric(A(i, 1)) And IsNumeric(B(i, 1)) Then
  33.           If Abs(A(i, 1) - B(i, 1)) > Eps Then Cells(i, "G").Interior.color = vbYellow
  34.         Else
  35.           If A(i, 1) <> B(i, 1) Then Cells(i, "G").Interior.color = vbYellow
  36.         End If
  37.     Next
  38.  End If
  39.  ComboBox4.Clear
  40. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

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

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы