Makro ändern/Buchstaben erkennen
27.12.2006 11:30:55
Stamereilers
Könnt ihr folgendes Makro so ändern, das auch Namen erkannt werden?
Option Explicit
'Kalender/Termin
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim wks As Worksheet
Dim vRow As Variant, iRow As Integer
Application.ScreenUpdating = False
If Target.Column <> 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
Cancel = True
Set wks = Worksheets("tabelle2")
vRow = Application.Match(CDbl(Target.Value), wks.Columns(1), 0)
If IsError(vRow) Then
Beep
MsgBox "An diesem Tag keinen Termin gefunden!"
Exit Sub
End If
iRow = 2
Do Until IsEmpty(wks.Cells(iRow, 1))
If CDbl(wks.Cells(iRow, 1).Value) = CDbl(Target.Value) Then
wks.Cells(iRow, 3).Value = 1
Else
wks.Cells(iRow, 3).Value = 2
End If
iRow = iRow + 1
Loop
wks.Range("A1").CurrentRegion.Sort key1:=wks.Range("C2"), order1:=xlAscending, header:=xlYes
' wks.Columns(3).ClearContents
Application.Goto wks.Range("A1"), True
Application.ScreenUpdating = True
End Sub
Vielen Dank für eure Hilfe!
Gruß
Rolf