Sub CountChars()
23.01.2024 07:43:09
Nordic
für nachfolgende Anforderung gibt es sicherlich schlauere Lösungen, ich hab mich in einem ersten Schritt dem mal semioptimal angenähert.
Meine geschätzten KollegInnen möchten die Eingaben im Bereich W7:NX156 Zeile für Zeile mitgezählt\ausgewertet haben.
Ideal wäre natürlich, dass neben der Anzahl "f" (Fehlzeit) nur die Module berücksichtigt werden (bestenfalls schon bei der Eingabe) die der TN auch tatsächlich gebucht hat ("x" bei E$7:O$7).
Beispiel die der beiliegenden Demo: TN1 (B7) hat die Module 1,2,8 und 10. Nun soll in der Zeile gezählt werden wie oft die 1,2,8 und die 10 (für 10 gilt alternativ auch P ) eingegeben wurde. Für TN3 (B9) wäre es die Anzahl von 1,2,4 und 8. "f" für Fehlzeit wird immer gezählt.
Da jedes Modul eine bestimmt Anzahl von Tagen (Ressourcen: D2:E12) dauert wäre es natürlich vorteilhaft wenn IST dem SOLL gegenübergestellt wird (Beispiel: M1 = 2/3, M2 = 7/8, usw)
Um die Tabelle nicht noch weiter aufzublähen will ich das jeweilige Ergebnis ab B$7 in ein Kommentar schreiben.
Hierzu hab ich mir folgendes gebastelt, was jedoch Zeile für Zeile die gleichen Werte ermittelt, was natürlich nicht sein kann.
(Derzeit hab ich keine Unterscheidung nach gewähltem Modul, da mir hierzu der Ansatz fehlt. Daher versuch ich alles auszulesen)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 22 And Target.Cells.Count = 1 Then
If Target.Value = "x" Then
Target.EntireRow.Hidden = True
ElseIf Target.Value = "" Then
Target.EntireRow.Hidden = False
End If
End If
Dim MyRange As Range
Set MyRange = Me.Range("W7:NX156")
If Not Application.Intersect(MyRange, Range(Target.Address)) Is Nothing Then
Call CountChars
End If
End Sub
Sub CountChars()
Dim i As Long: i = 7
Dim rng As Range
Set rng = Worksheets("Projektplan").Range(Cells(i, 23), Cells(i, 388))
Dim Count_1 As Integer: Count_1 = 0
Dim Count_2 As Integer: Count_2 = 0
Dim Count_3 As Integer: Count_3 = 0
Dim Count_4 As Integer: Count_4 = 0
Dim Count_5 As Integer: Count_5 = 0
Dim Count_6 As Integer: Count_6 = 0
Dim Count_7 As Integer: Count_7 = 0
Dim Count_8 As Integer: Count_8 = 0
Dim Count_9 As Integer: Count_9 = 0
Dim Count_10 As Integer: Count_10 = 0
Dim Count_P As Integer: Count_P = 0
Dim Count_11 As Integer: Count_11 = 0
Dim Count_f As Integer: Count_f = 0
Dim cell As Range
For i = 7 To gLR
For Each cell In rng
Count_1 = Count_1 + Len(cell.Value) - Len(Replace(cell.Value, "1", ""))
Count_2 = Count_2 + Len(cell.Value) - Len(Replace(cell.Value, "2", ""))
Count_3 = Count_3 + Len(cell.Value) - Len(Replace(cell.Value, "3", ""))
Count_4 = Count_4 + Len(cell.Value) - Len(Replace(cell.Value, "4", ""))
Count_5 = Count_5 + Len(cell.Value) - Len(Replace(cell.Value, "5", ""))
Count_6 = Count_6 + Len(cell.Value) - Len(Replace(cell.Value, "6", ""))
Count_7 = Count_7 + Len(cell.Value) - Len(Replace(cell.Value, "7", ""))
Count_8 = Count_8 + Len(cell.Value) - Len(Replace(cell.Value, "8", ""))
Count_9 = Count_9 + Len(cell.Value) - Len(Replace(cell.Value, "9", ""))
Count_10 = Count_10 + Len(cell.Value) - Len(Replace(cell.Value, "10", ""))
Count_P = Count_P + Len(cell.Value) - Len(Replace(cell.Value, "P", ""))
Count_11 = Count_11 + Len(cell.Value) - Len(Replace(cell.Value, "11", ""))
Count_f = Count_f + Len(cell.Value) - Len(Replace(cell.Value, "f", ""))
Next cell
With Worksheets("Projektplan").Cells(i, 2)
If Not .Comment Is Nothing Then .Comment.Delete
.AddComment "Modul 1: " & Count_1 & vbNewLine & _
"Modul 2: " & Count_2 & vbNewLine & _
"Modul 3: " & Count_3 & vbNewLine & _
"Modul 4: " & Count_4 & vbNewLine & _
"Modul 5: " & Count_5 & vbNewLine & _
"Modul 6: " & Count_6 & vbNewLine & _
"Modul 7: " & Count_7 & vbNewLine & _
"Modul 8: " & Count_8 & vbNewLine & _
"Modul 9: " & Count_9 & vbNewLine & _
"Modul 10: " & Count_10 & vbNewLine & _
"betr.Erp: " & Count_P & vbNewLine & _
"Modul 11: " & Count_11 & vbNewLine & _
"--------------" & vbNewLine & _
"Fehltage: " & Count_f & vbNewLine
End With
Count_1 = 0
Count_2 = 0
Count_3 = 0
Count_4 = 0
Count_5 = 0
Count_6 = 0
Count_7 = 0
Count_8 = 0
Count_9 = 0
Count_10 = 0
Count_P = 0
Count_11 = 0
Count_f = 0
Next i
End Sub
https://www.herber.de/bbs/user/166284.xlsm
Wo ist der Fehler?
Euch einen entspannten Tag und VG, Nordic (Uwe)