Сделайте несколько, но отдельные символы в строке жирным шрифтом - PullRequest
Новая
       11

Сделайте несколько, но отдельные символы в строке жирным шрифтом

0 голосов
/ 25 апреля 2018

У меня есть ячейка с текстом, например:

k a2 d eu1 n - oe2 r gj y2 t lj e2 r i1 - t y1 r kj - jh e2 z aa1

В конце концов это должно быть так:

k a2 d eu 1 n - oe2 r gj y2 t lj e2 r i 1 - t y 1 r kj - jh e2 z aa 1

Для этого значение ячейки сохраняется в переменной v3.

Public Sub Guide()


Dim v3 As String
Dim i, j As Integer
Dim pos, pos1 As Long

v3 = Sheets("Script").Cells(12, 8).Value

i = 1
j = 0

Do
   j = InStr(i, v3, "1", vbTextCompare)
   i = j + 1


   pos = InStrRev(v3, " ", (j - 1))
   pos1 = (j - 1) - pos

 Call BoldText(v3, j - pos1, pos1)

Loop Until j = 0


End Sub

Вот так я получаю положение буквы перед 1, (j - 1) и сколько символов между предыдущим пробелом и 1, pos1 ...

Thisis "BoldText": 

Sub BoldText(Txt, strt As Integer, Lngt)
Dim Ln As Long

Ln = Len(Txt)



Range("H12").Select

With ActiveCell.Characters(Start:=1, Length:=(strt - 1)).Font
        .FontStyle = "Regular"
End With
With ActiveCell.Characters(Start:=strt, Length:=Lngt).Font
        .FontStyle = "Bold"
End With
With ActiveCell.Characters(Start:=(strt + Lngt + 1), Length:=(Ln - strt)).Font
        .FontStyle = "Regular"
End With


End Sub

Таким образом, он сохраняет символы 1 to (one before the bold) обычным шрифтом.Те, которые мы хотим, будут выделены жирным шрифтом, а затем (one after bold) to End снова регулярно.

Как можно было бы достичь этого с несколькими экземплярами, чтобы достичь конечного результата?

В данный момент на каждом цикле сбрасывается последний.Excel ожидает, что он будет в синтаксисе 1 to (x - 1) = обычный шрифт, x = жирный шрифт, x + 1 to (y-1) = обычный, y = жирный, y + 1 to (z - 1) и т. Д. Я просто не уверен, какСценарий это.

Большое спасибо заранее.Если вам нужно что-то более ясное, я могу сделать все возможное, чтобы объяснить больше.

1 Ответ

0 голосов
/ 25 апреля 2018

Это немного поспешно (и немного взломать), но, по крайней мере, вы должны начать с него. Он использует регулярные выражения. Вы можете превратить некоторые из них в подпрограмму с параметрами. 

Sub Regex2()

Dim oMatches As Object, i As Long, vOut

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\s([a-z]+)1"
    Set oMatches = .Execute(Range("A1"))
End With

ReDim vOut(0 To oMatches.Count - 1, 1 To 3)

For i = 0 To oMatches.Count - 1
    vOut(i, 1) = oMatches(i).submatches(0)
    vOut(i, 2) = oMatches(i).firstindex
    vOut(i, 3) = oMatches(i).Length
Next i

For i = LBound(vOut) To UBound(vOut)
    Range("A1").Characters(vOut(i, 2) + 1, vOut(i, 3) - 1).Font.Bold = True
Next i

End Sub
...