tahsinanarat
Altın Üye
- Katılım
- 14 Mart 2005
- Mesajlar
- 2,181
- Excel Vers. ve Dili
- Ofis 2019 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Bold()
Application.ScreenUpdating = False
For i = 1 To [a65536].End(3).Row
For x = 1 To Len(Cells(i, 1))
If Mid(Cells(i, 1), x, 1) = "(" Then _
y = x: Cells(i, 1).Replace What:="(", Replacement:="", LookAt:=xlPart
If Mid(Cells(i, 1), x, 1) = ")" Then z = (x - y): Cells(i, 1).Replace What:=")", Replacement:="", LookAt:=xlPart
If y <> Empty And z <> Empty Then _
Cells(i, 1).Characters(Start:=y, Length:=z).Font.Bold = True: y = Empty: z = Empty
Next x
Next i
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
For i = 1 To [a65536].End(3).Row
[b:b].Clear
a = 0: b = 0
For x = 1 To Len(Cells(i, 1))
If Mid(Cells(i, 1), x, 1) = "[" Then Cells([b50].End(3).Row + 1, 2) = x - a: a = a + 2
If Mid(Cells(i, 1), x, 1) = "]" Then Cells([b50].End(3).Row + 1, 2) = x - Cells([b50].End(3).Row, 2).Value - b: b = b + 2
Next x
Cells(i, 1).Replace What:="[", Replacement:="", lookat:=xlPart
Cells(i, 1).Replace What:="]", Replacement:="", lookat:=xlPart
For c = 2 To [b50].End(3).Row Step 2
Cells(i, 1).Characters(Start:=Cells(c, 2).Value, Length:=Cells(c + 1, 2).Value).Font.Bold = True
Next c
Next i
Application.ScreenUpdating = True
[b:b].Clear
End Sub