VBA: Строка (например, «35 миль»), встроенная в ячейку - как отформатировать ячейку в зависимости от расстояния? - PullRequest
1 голос
/ 30 января 2020

Прошу прощения за заголовок - я не знаю, как это сформулировать.

Я получаю отчет, который определяет местоположение человека по отношению к пункту назначения и вычисляет расстояние между ними, которое затем экспортируется в Excel. На оси X находится дата, а на оси Y есть человек. Затем ячейка содержит данные, такие как:

Назначение: ПРИМЕР

Широта: ПРИМЕР

Долгота: ПРИМЕР

Расстояние от начальной точки: 35 миль

(а затем еще немного информации).

Я хотел бы использовать некоторый код, который будет выделять ячейки разными цветами в зависимости от того, как далеко расстояние от начальной точки. Например, если <40 миль, зеленый, 40-60 миль, желтый,> 60 миль, красный.

Я знаю, как изолировать текстовую строку, если у меня есть определенный c текст, но учитывая, что Я хочу найти что-нибудь от 1 мили до нескольких сотен миль, я не уверен, как это закодировать. Мили также не единственные числа в ячейке, поэтому я не могу выделить числа и искать только их.

Это то, что у меня есть:

Sub Highlight_cells

Dim lastRow As Long
lastRow = Range("A1").End(xlDown).Row

With Range("B2:CA" &lastRow).FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="*miles*")
With .Interior
.Color = RGB(102 255 153)
End With
End With

End Sub

Но очевидно, что это просто подчеркивает что-либо словом «мили».

У кого-нибудь есть какие-либо предложения? Я на правильном пути?

Большое спасибо заранее.

Редактировать: Снимок экрана с примерами данных enter image description here

Ответы [ 2 ]

3 голосов
/ 30 января 2020

Попробуйте этот код, пожалуйста:

Sub Highlight_cells()
Dim rng As Range, sh As Worksheet
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition
Dim lastRow As Long

Set sh = ActiveSheet 'Please put here your sheet
lastRow = sh.Range("A" & sh.Rows.count).End(xlUp).Row
Set rng = sh.Range("B2:CA" & lastRow)

rng.FormatConditions.Delete
'<40 miles, green, 40-60 miles, yellow, >60 miles, red.
Set cond1 = rng.FormatConditions.Add(xlExpression, Formula1:="=VALUE(MID(B2,FIND("" miles"",B2,1)-3,3))<40")
Set cond2 = rng.FormatConditions.Add(xlExpression, _
    Formula1:="=AND(VALUE(MID(B2,FIND("" miles"",B2,1)-3,3))>=40,VALUE(MID(B2,FIND("" miles"",B2,1)-3,3))<=60)")
Set cond3 = rng.FormatConditions.Add(xlExpression, Formula1:="=VALUE(MID(B2,FIND("" miles"",B2,1)-3,3))>60")

  With cond1
     .Interior.Color = vbGreen
     .Font.Italic = True
     .SetFirstPriority
  End With       
  With cond2
    .Interior.Color = vbYellow
  End With
  With cond3
    .Font.Color = vbWhite
    .Font.Bold = True
    .Interior.Color = vbRed
  End With
End Sub
1 голос
/ 30 января 2020

Вы даже можете сделать это с формулой:

=VALUE(MID(A1,FIND("Distance from last location: ",A1)+LEN("Distance from last location: "),FIND(" miles",A1,FIND("Distance from last location: ",A1))-FIND("Distance from last location: ",A1)-LEN("Distance from last location: ")))

будет извлекать расстояние. Затем форматирование может быть выполнено с помощью условного форматирования.

Вы также можете использовать эту формулу в условном форматировании, если вам не нужен дополнительный столбец.

Эту формулу также можно легко расширить, если Вы хотите извлечь несколько столбцов: DI будет использовать заголовки столбцов, где вы указываете начало и конец значения и связываете их в формуле. (Разрыв строки будет CHAR (10)). С правильными $ References у вас должны быть одинаковые формулы для нескольких значений: D

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