Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Nisan 2005 Pazar

Characters Find In Text

'Module1

Option Explicit
Dim X As Single, Y As Single

Sub YazıKarakterTesbiti() 'Characters Find In Text
On Error Resume Next
For X = 1 To [A65536].End(3).Row
For Y = 1 To VBA.Len(Cells(X, 1))
Cells(X, Y + 1).Value = Cells(X, 1).Characters(Start:=Y, Length:=1).Text
Cells(X, Y + 1).Font.ColorIndex = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.ColorIndex
Cells(X, Y + 1).Font.Bold = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Bold
Cells(X, Y + 1).Font.Underline = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Underline
Cells(X, Y + 1).Font.Italic = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Italic
Cells(X, Y + 1).Font.Size = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Size
Cells(X, Y + 1).Font.name = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.name
Cells(X, Y + 1).Font.Type = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Type
Cells(X, Y + 1).Font.FontStyle = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.FontStyle
Cells(X, Y + 1).Font.Strikethrough = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Strikethrough
Cells(X, Y + 1).Font.Superscript = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Superscript
Cells(X, Y + 1).Font.Subscript = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Subscript
Cells(X, Y + 1).Font.OutlineFont = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.OutlineFont
Cells(X, Y + 1).Font.Shadow = Cells(X, 1).Characters(Start:=Y, Length:=1).Font.Shadow
Cells(X, Y + 1).Columns.AutoFit
Next Y
Next X
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul