Hallo Ihr Lieben,
Ich muss ab und an für einen Bekannten Auswertungen machen und daraus eine sogenannte Heatmap erstellen. Dafür stellt er mir Rohdaten zur Verfügung in mehreren Dateien.
Diese fasse ich in einer Tabelle zusammen. Oft sind das Quartalsauswertungen. D.h. ich habe in einer Spalte die Daten (01.01.2020-31.03.2020) und in der oberen Zeile Zeitschlitze im Raster von 1 Stunde. Also ~90*24 Zellen und das oft für 6-8 Dateien (Auswertung identisch - nur unterschiedliche Stammdaten - aber vergleichbar, da gleiche Abteilung z.B.)
In diesen Zellen steht dann eine Zahl von 0-60 Minuten.
Nun soll quasi im ersten Tabellenblatt dargestellt werden, wie viele der Abteilungen z.B. zeitgleich geschlossen waren (Es gibt die Möglichkeit diese Abteilungen von 10 bis 60 Min zu schließen). Da mein Bekannter mir vorgibt, ab wie viel Minuten eine Abteilung im Zeitschlitz als geschlossen gilt, müsste ich quasi z.B.
Alle Daten größer 20 Min als 1 darstellen, damit ich auf der ersten Seite eine Summe erzeugen kann. Diese würde dann z.B bei 100% geschlossenen Abteilungen rot dargestellt werden im Zeitschlitz.
Nun ich bekomme die Rohdaten alle soweit in eine Datei geschrieben - aber dann hapert es beim Umschreiben der Daten. :(
Kann mir dabei jemand helfen?
Aktuell sieht mein Gesamtcode so aus:
Sub TabelleAusMehrerenDateienEinlesen()
Dim Zieldatei As Object
Dim Quelldatei As Object
Dim Pfad As String
Dim Datei As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Festlegen, in welcher Arbeitsmappe, die Tabellen kopiert werden
Set Zieldatei = Workbooks("Mappe1")
'Schleife über alle Excel-Dateien // Ziel-Pfad hier angeben
Pfad = "C:\Desktop\Auswertungen\Rohdaten\"
Datei = Dir(CStr(Pfad & "*.xl*"))
Do While Datei <> ""
'Datei öffnen und Dateiübertragung
Set Quelldatei = Workbooks.Open(Pfad & Datei, False, True)
'Es wird das Tabellenblatt mit Namen "1 Kumulation" übertragen
Quelldatei.Sheets("1 Kumulation").Copy after:=Zieldatei.Sheets(Zieldatei.Sheets.Count)
'Dateinamen als Tabellenname, falls nicht möglich: Typischer Tabellenname (Tabelle 2 ...)
On Error Resume Next
Zieldatei.Sheets(Zieldatei.Sheets.Count).Name = Datei
'Fehler-Reset
If Err.Number <> 0 Then
Err.Number = 0
Err.Clear
End If
On Error GoTo 0
'Datei schließen und zur nächsten Datei
Quelldatei.Close False
'Nächste Datei
Datei = Dir()
Loop
Call SpaltenLoeschen
'Call WerteErsetzen
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Die Rohdaten sind vorbereitet!", vbInformation + vbOKOnly, "Hinweis!"
'Variablen aufräumen
Set Zieldatei = Nothing
Set Quelldatei = Nothing
Set Quelltabelle = Nothing
End Sub
Sub SpaltenLoeschen()
Dim Quelltabelle As Worksheet
' Für jedes Tabellenblatt in dem Spalte A Zeile 1 der Wert "Kumulation" steht, Spalte A und B löschen (Vorausgesetzt alle Dateien sind identisch aufgebaut)
For Each Quelltabelle In ActiveWorkbook.Worksheets
Quelltabelle.Activate
If (ActiveSheet.Range("A1").Value = "Kumulation") Then
Quelltabelle.Range("A:B").Select
Selection.Delete Shift:=x1ToLeft
End If
Next Quelltabelle
End Sub
Nun möchte ich die Funktion WerteErsetzen() schreiben, aber entweder steh ich auf dem Schlauch oder ich komme nicht weiter.
Als Beispiel wie die Tabelle aussieht:
01.01.2020 60 5 10 25 28 29 24 0 0 0 0 0 0 0 15 20 35 0 0 0 0 0 0 10
02.01.2020 ... usw.
Nun sollten in der o.g. Zeile aus der 60 , 25 , 28 , 29 , 24 , 20 und 35 eine 1 werden. Aus den anderen Zahlen eine 0.
Alle Tabellenblätter sind identisch aufgebaut.
Kann mir da ggf. jemand helfen? =D hatte erst an eine verschachtelte For While Schleife gedacht, dann ggf. an eine Do While solange zähler nicht größer worksheets.count und dann for each um durch jede Zeile zu gehen ? .__.
Danke im Voraus
Freundliche Grüße
Jennifer Braun
|