Thema Datum  Von Nutzer Rating
Antwort
Rot in bestimmtem Zellbereich Daten ändern
18.05.2020 18:24:21 Gast754321
NotSolved
18.05.2020 19:31:58 Gast41060
NotSolved
18.05.2020 20:47:29 Gast11352
NotSolved
18.05.2020 20:49:38 Gast62419
NotSolved
18.05.2020 22:32:09 Gast41060
Solved
19.05.2020 10:37:41 Gast57683
NotSolved

Ansicht des Beitrags:
Von:
Gast754321		 Datum:
18.05.2020 18:24:21		 Views:
1435		 Rating:
     
Antwort:
  Ja
Thema:
in bestimmtem Zellbereich Daten ändern

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:
 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot in bestimmtem Zellbereich Daten ändern
18.05.2020 18:24:21 Gast754321
NotSolved
18.05.2020 19:31:58 Gast41060
NotSolved
18.05.2020 20:47:29 Gast11352
NotSolved
18.05.2020 20:49:38 Gast62419
NotSolved
18.05.2020 22:32:09 Gast41060
Solved
19.05.2020 10:37:41 Gast57683
NotSolved