Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+s
'
Application.Goto Reference:="Makro1"
Dim strZ As String
Dim Cll As Range
Dim daa As Range
Dim objZ As Range
Dim i As Integer
Dim z As Integer
Dim myCell As Range
'Set myCell.Range = ActiveCell.Range
'myCell.Row = ActiveCell.Row - 1
'myCell.Column = ActiveCell.Column
strZ = "+ "
For Each Cll In Selection
Set objZ = Cells.Find _
(What:=strZ, After:=ActiveCell, SearchOrder:=xlByColumns, LookAt:=xlPart)
If objZ Is Nothing Then
GoTo Adios
Else
objZ = Application.WorksheetFunction.Substitute _
(objZ, strZ, vbLf & "- ")
objZ.Select
i = i + 1
End If
Next Cll
Adios:
MsgBox "Es wurden " & i & " Ersetzungen durchgeführt."
Set objZ = Nothing
Set Cll = Nothing
strZ = "-"
For Each daa In ActiveWorkbook.Worksheets(1).Cells
Set objZ = Cells.Find _
(What:=strZ, After:=ActiveCell, SearchOrder:=xlByRows, LookAt:=xlPart)
If objZ Is Nothing Then
End
Else
objZ = Application.WorksheetFunction.Substitute _
(objZ, strZ, "+ ")
objZ.Select
i = i + 1
End If
z = InStr(ActiveCell, "+ ")
With ActiveCell.Characters(Start:=1, Length:=0).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 9.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=1, Length:=z).Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 9.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=z, Length:=8).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 9.5
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Next daa
End Sub
|