SHARE
TWEET

SuitsColors3

a guest Dec 6th, 2019 77 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub test()
  2. Dim rngCell As Range
  3. Dim CharCount As Integer
  4. Dim BracketBegin As Integer
  5. Dim BracketEnd As Integer
  6. Dim strToColour As String
  7. Dim riverBegin As Integer
  8. Dim riverEnd As Integer
  9. Dim sh, s$, j$()
  10. On Error GoTo errr
  11. X = Cells(Rows.Count, 1).End(xlUp).Row
  12. For Each sh In Range("A5:B" & X & "")  ' A5:B это диапозон в котором происходит макрос, '
  13. ' если будут еще 1 столбец то ставь A5:С и так далее '
  14. ' п.с нижний диапозон не надо указывать он красит по всем строкам которые есть в файле '
  15. sh.Cells.Replace Trim$("s"), Trim$(ChrW(9824))
  16. sh.Cells.Replace Trim$("c"), Trim$(ChrW(9827))
  17. sh.Cells.Replace Trim$("h"), Trim$(ChrW(9829))
  18. sh.Cells.Replace Trim$("d"), Trim$(ChrW(9830))
  19. Next
  20. errr:
  21.  
  22.  
  23. For Each rngCell In Range("A5:B" & X & "") ' и вот тут тоже '
  24.         ' first '
  25.        CharCount = Len(rngCell)
  26.         BracketBegin = 0
  27.         If CharCount = 2 Then
  28.         BracketEnd = Len(rngCell)
  29.         Else
  30.         BracketEnd = InStr(1, rngCell, " ")
  31.         End If
  32.     With rngCell.Characters(BracketBegin, BracketEnd)
  33.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  34.         If InStr(strToColour, ChrW(9829)) Then
  35.             .Font.Color = vbRed
  36.         Else
  37.         End If
  38.     End With
  39.         With rngCell.Characters(BracketBegin, BracketEnd)
  40.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  41.         If InStr(strToColour, ChrW(9827)) Then
  42.             .Font.Color = vbGreen
  43.         Else
  44.         End If
  45.     End With
  46.         With rngCell.Characters(BracketBegin, BracketEnd)
  47.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  48.         If InStr(strToColour, ChrW(9830)) Then
  49.             .Font.Color = vbBlue
  50.         Else
  51.         End If
  52.     End With
  53.         With rngCell.Characters(BracketBegin, BracketEnd)
  54.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  55.         If InStr(strToColour, ChrW(9824)) Then
  56.             .Font.Color = vbBlack
  57.         Else
  58.         End If
  59.     End With
  60.     ' second '
  61.        BracketBegin = InStr(1, rngCell, " ")
  62.         BracketEnd = InStr(2, rngCell, " ")
  63.     With rngCell.Characters(BracketBegin, BracketEnd)
  64.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  65.         If InStr(strToColour, ChrW(9829)) Then
  66.             .Font.Color = vbRed
  67.         Else
  68.         End If
  69.     End With
  70.         With rngCell.Characters(BracketBegin, BracketEnd)
  71.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  72.         If InStr(strToColour, ChrW(9827)) Then
  73.             .Font.Color = vbGreen
  74.         Else
  75.         End If
  76.     End With
  77.         With rngCell.Characters(BracketBegin, BracketEnd)
  78.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  79.         If InStr(strToColour, ChrW(9830)) Then
  80.             .Font.Color = vbBlue
  81.         Else
  82.         End If
  83.     End With
  84.         With rngCell.Characters(BracketBegin, BracketEnd)
  85.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  86.         If InStr(strToColour, ChrW(9824)) Then
  87.             .Font.Color = vbBlack
  88.         Else
  89.         End If
  90.     End With
  91.     ' third '
  92.        BracketBegin = 6
  93.         BracketEnd = Len(rngCell)
  94.     With rngCell.Characters(BracketBegin, BracketEnd)
  95.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  96.         If InStr(strToColour, ChrW(9829)) Then
  97.             .Font.Color = vbRed
  98.         Else
  99.         End If
  100.     End With
  101.         With rngCell.Characters(BracketBegin, BracketEnd)
  102.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  103.         If InStr(strToColour, ChrW(9827)) Then
  104.             .Font.Color = vbGreen
  105.         Else
  106.         End If
  107.     End With
  108.         With rngCell.Characters(BracketBegin, BracketEnd)
  109.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  110.         If InStr(strToColour, ChrW(9830)) Then
  111.             .Font.Color = vbBlue
  112.         Else
  113.         End If
  114.     End With
  115.         With rngCell.Characters(BracketBegin, BracketEnd)
  116.         strToColour = rngCell.Characters(BracketBegin, BracketEnd).Text
  117.         If InStr(strToColour, ChrW(9824)) Then
  118.             .Font.Color = vbBlack
  119.         Else
  120.         End If
  121.     End With
  122. Next rngCell
  123. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top