AW: Umwandeln von Text in Zahl
Text
Hi Jac,
https://www.herber.de/bbs/user/12336.xls
mit nachfolgendem Code. Die Codes aus den 12 Tabellenblättern habe ich einfernt und in dieseArbeitmappe gepackt. Im Blatt "Daten", kann man ja später ausblenden, musst du noch ergänzen, habee nur: 1, K, K.5, U, U.5 eingetragen.
Achja, Modul2 kannste entfernen, diente nur zum Aufzeichnen, vergessen zu löschen.
Gruß
Reinhard
In Modul1:
Function SummeX(ByRef Bereich As Range)
On Error GoTo Fehler
Set AC = Application.Caller
If AC.Column = 35 And AC.Row <= 20 Then spa = 2 ' Monatssume pro Mitarbeiter
If AC.Row = 25 And AC.Column <= 34 Then spa = 3 ' Abwesende
If AC.Row = 24 And AC.Column <= 34 Then spa = 4 ' Anwesende
For Each Zelle In Bereich.Cells
If Zelle <> "" Then SummeX = SummeX + Application.WorksheetFunction. _
VLookup(Zelle.Value, Worksheets("Daten").Range("A2:D50"), spa, 0)
Next Zelle
Exit Function
Fehler:
SummeX = "#FEHLER#"
End Function
Sub Einblenden()
Worksheets("Daten").Visible = True
End Sub
Sub Ausblenden()
Worksheets("Daten").Visible = False
End Sub
In "DieseArbeitsmappe"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Daten" Or Sh.Name = "Pekulium Jan.-Juni" Or Sh.Name = _
"Pekulium Juli-Dez." Then Exit Sub
'David McRitchie, 2000-08-08 rev. 2000-08-14
' mod 2004-05-15 for "scire" <anonymous@discussions.microsoft.com>,
' mod 2004-08-25 Pragmatica AG /LPO
' <a href="http://www.mvps.org/dmcritchie/excel/event.htm#case">http://www.mvps.org/dmcritchie/excel/event.htm#case</a>
Dim xLetter As String
Dim vColor As Integer
Dim cRange As Range
Dim cell As Range
With Worksheets(Sh.Name)
'***** if you really just want to check the rows use something like:
'--------- if target.row < 2 then exit sub
'***************** check range ****
Set cRange = Intersect(.Range("d4:ah24"), Target)
If cRange Is Nothing Then Exit Sub
For Each Zelle In Target
xLetter = UCase(Left(Zelle.Value & " ", 1))
'see colors.htm and event.htm in same directory as
' <a href="http://www.mvps.org/dmcritchie/excel/excel.htm">http://www.mvps.org/dmcritchie/excel/excel.htm</a>
vColor = 0 'default is no color
Select Case xLetter
Case "G"
vColor = 8
Case "K"
vColor = 39
Case "U"
vColor = 45
Case "F"
vColor = 41
Case "A"
vColor = 7
Case "E"
vColor = 12
Case "N"
vColor = 6
Case "X"
vColor = 3
Case "O"
vColor = 4
Case "V"
vColor = 15
End Select
Application.EnableEvents = False 'should be part of Change macro
Zelle.Interior.ColorIndex = vColor
Application.EnableEvents = True 'should be part of Change macro
Next Zelle
'Target.Offset(0, 1).Interior.colorindex = vColor
End With
End Sub
Sub tt()
Application.EnableEvents = True
End Sub