Makro ile Metin biçimlendirme

[ikikan]

Arkadaşlar bu kod işe yarıyor faka fazla kasıyor daha hızlı yapabilecek bir kod varmıdır, çok acil lazım şimdiden teşekürler.

Örnek dosya ektedir:

Sub Kalınyaz()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.Volatile
Sheets("DD").Range("B12:B1500").Value = Sheets("TR").Range("J12:J1500").Value
Sheets("DD").Range("A12:A1500").Value = Sheets("TR").Range("I12:I1500").Value

With Sheets("DD").Range("A7:B1500").Font
.Name = "Arial"
.FontStyle = "Kalın"
.Size = 10
End With

For i = 1 To Sheets("DD").Cells(Rows.Count, 2).End(3).Row
bas = 0
bit = 0
aranan = Chr(10)
For x1 = 1 To Len(Sheets("DD").Cells(i, 2).Value)

If Mid(Sheets("DD").Cells(i, 2).Value, x1, 1) = aranan And bas = 0 Then
bas = x1

ElseIf Mid(Sheets("DD").Cells(i, 2).Value, x1, 1) = aranan And bas > 0 Then
With Sheets("DD").Cells(i, 2).Characters(Start:=bas, Length:=bit + 1).Font
.Name = "Arial"
.FontStyle = "İtalik"
.Size = 8
End With
bas = 0
bit = 0

ElseIf bas > 0 Then
bit = bit + 1
End If

Next x1
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

 

[Orion1]

kırmızı yeri değiştiriseniz bir miktar daha hızlanır.

With Sheets("DD").Range("A7:B1500").Font
.Name = "Arial"
.FontStyle = "Kalın"
.Size = 10
End With
[B][COLOR="Red"]sat = Sheets("DD").Cells(Rows.Count, 2).End(3).Row[/COLOR][/B]
For i = 1 To [B][COLOR="Red"]sat[/COLOR][/B]