ich habe ein kleines Problemchen bei dem ich nicht weiter komme.
Ich habe die Aufgabe einen Statusbericht anzufertigen und scheitere schon an der Datenbasis.
Ich habe in einem Tabellenblatt mehrere Spalten mit Werten. Ich habe ein Makro "zusammengebastelt" das eine Spalte durchsucht und die mehrfach vorkommenden Werte zusammenzählt. Dann wird das Ergebnis auch ausgegeben. Soweit so gut
Status Quo:
21.03.2019 114
194
26.02.2018 58
11.04.2019 177
not relevant 38
23.05.2019 174
14.02.2019 141
23.11.2018 177
Hier gibt es jedoch 5 Probleme:
1. es werden auch leere Zellen aufgezählt und ein Kenner not relevant der ignoriert werden soll
2. es wird nur eine Spalte durchsucht und ich habe keine Ahnung wie ich es schaffe die weiteren 8 Spalten (Spalte 5,7,10,11,12,15,19,23) auch zu durchsuchen und die Werte im neuen Tabellenblatt Statusbericht_Datum ausgeben.
3. Wenn ich das Makro mehrfach durchlaufen lasse bekomme ich einen Fehler da er das neue Tabellenblatt nicht überschreibt.
4. Ich schaffe es nicht das neue Tabellenblatt in der Form Statusbericht_Datum zu erzeugen.
5. Ich finde keinen Weg um dann nochmals die Summe der einzelnen Werte zu bilden
Idealerweise sollte das Ergebnis so aussehen, damit ich dann ein Liniendiagramm mit den jeweiligen Wertepaaren (x Zeit und Y aufsummierte Werte aufbauen kann.
21.03.2019 114 114
26.02.2018 58 172
11.04.2019 177 349
23.05.2019 174 523
14.02.2019 141 664
23.11.2018 177 841
Sorry für die vielen Fragen! Aber ich bin hier am verzweifeln und habe leider nicht mehr viel Zeit fertig zu werden.
Anbei der Status Quo meines Codes:
Sub NeuerTag()
Dim sh As Worksheet
With Worksheets
Set sh = .Add
sh.Name = "Statusbericht" & " " & VBA.Date
sh.Move , Sheets(.Count)
End With
End Sub
Sub Datenaufbereitung()
Dim i As Long, j As Long
Dim lpMaxLine As Long
Dim lpCount As Long
Dim lpNumber As Long
Dim lpWord As String
Dim WS As Worksheet
Dim lArray() As String
Dim bFound As Boolean
Set WS = ThisWorkbook.Worksheets("FROP")
lpMaxLine = WS.Range("A:Z").SpecialCells(xlCellTypeLastCell).Row
For i = 2 To lpMaxLine
lpWord = WS.Cells(i, 7)
' ws.Range(ws.Cells(i, 5), ws.Cells(i, 7))
' lpWord = WS.Range(WS.Cells(i, 5), WS.Cells(i, 7)).Borders(xlEdgeTop).LineStyle = _
xlContinuous
bFound = False
For j = 1 To lpCount
If lArray(1, j) = lpWord Then
lArray(2, j) = lArray(2, j) + 1
bFound = True
End If
Next j
If Not bFound Then
lpCount = lpCount + 1
ReDim Preserve lArray(1 To 2, 1 To lpCount)
lArray(1, lpCount) = lpWord
lArray(2, lpCount) = 1
End If
Next i
Sheets.Add
ActiveSheet.Name = "Daten"
Set WS = ThisWorkbook.Worksheets("Daten")
For i = 1 To lpCount
WS.Cells(i + 1, 1) = lArray(1, i)
WS.Cells(i + 1, 2) = lArray(2, i)
Next i
End Sub