Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1628to1632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tabelle umwandeln

Tabelle umwandeln
22.06.2018 13:02:29
Klaus
Hallo,
kann mir jemand mit folgender Aufgabe helfen, Beispiel anbei.
https://www.herber.de/bbs/user/122249.xlsx
Ich habe eine Tabelle auf Blatt 1 zum Stunden eintragen, aufgebaut ist diese als Matrix, enthalten ist Woche, Tätigkeit und Stunden pro Tag
Auf Blatt 2 möchte ich gerne eine tabellarische Ansicht: sortiert nach Woche und Tag (im Datumsformat), Stunden sind nach Tätigkeit pro Tag addiert.
Gibt es eine Möglichkeit das per VBA zu generieren? Meine Möglichkeiten sind sehr begrenzt.
Vielen Dank schon im Voraus
Gruß
Klaus

25
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: möglich wäre eine reine Formellösung ...
22.06.2018 16:48:54
neopa
Hallo Klaus,
... eine solche hab ich zunächst selbst für kaum realisierbar gehalten, aber es hat mich halt interessiert.
Es reicht je Spalte nur eine nach unten zu kopierende Formel (jeweils eine Matrixfunktion(alität)sformel, die keines spez. Formelabschluss wie eine klassische Matrixformel benötigt).
Ich setze jedoch voraus, dass Du keine tausende oder viele hunderte Datensätze auswerten musst.
Die Formeln sind allerdings nicht einfach zu verstehen. Die nachfolgende Formel für D2 ist noch die einfachste der vier Formeln:
=SUMME(INDEX((7*KÜRZEN((2&-1&-Tabelle1!$B$9)/7+Tabelle1!A$12:A$99)-{5.4.3.2.1}=B2)*(Tabelle1!B$12:B$99=C2)*Tabelle1!C$12:G$99;))
Auf die Wiedergabe der anderen drei Formeln verzichte ich vorläufig, weil Du ja eine VBA-Lösung angestrebt hast.
Gruß Werner
.. , - ...
Anzeige
AW: möglich wäre eine reine Formellösung ...
22.06.2018 20:49:28
Günther
Moin Klaus,
auch ich "umschiffe" die Makros (obwohl mir beim ersten Durchlauf das Finden der Lösung damit gewiss leichter gefallen wäre ;-) ) und habe das "just for fun" mit Power Query gelöst. Und der Bequemlichkeit halber habe ich eine Hilfsspalte mit dem berechneten Montag-Datum der KW in die Rohdaten eingefügt (wie prinzipiell auch Werner, er hatte das aber in die Formel integriert). - Und ja, ich hätte auch auf die Hilfsspalte verzichten können, aber HS an sich beißen ja nicht und sind auch nicht böse ...
Gruß
Günther
Hier noch für die Cracks unter euch der generierte M-Code:
let
Quelle = Excel.CurrentWorkbook(){[Name="RawData"]}[Content],
#"Geänderter Typ" = Table.TransformColumnTypes(Quelle,{{"Woche", Int64.Type}, {"Tätigkeit",  _
type text}, {"MoDatum", type date}, {"Montag", type number}, {"Dienstag", type number}, {"Mittwoch", type number}, {"Donnerstag", type number}, {"Freitag", type number}}),
#"Entpivotierte andere Spalten" = Table.UnpivotOtherColumns(#"Geänderter Typ", {"Woche", "Tä _
tigkeit", "MoDatum"}, "Attribut", "Wert"),
#"Hinzugefügte benutzerdefinierte Spalte" = Table.AddColumn(#"Entpivotierte andere Spalten", _
"Datum", each if [Attribut]="Dienstag"
then Date.AddDays([MoDatum],1)
else if [Attribut]="Mittwoch"
then Date.AddDays([MoDatum],2)
else if [Attribut]="Donnerstag"
then Date.AddDays([MoDatum],3)
else if [Attribut]="Freitag"
then Date.AddDays([MoDatum],4)
else [MoDatum]),
#"Entfernte Spalten" = Table.RemoveColumns(#"Hinzugefügte benutzerdefinierte Spalte",{" _
MoDatum", "Attribut"}),
#"Gruppierte Zeilen" = Table.Group(#"Entfernte Spalten", {"Woche", "Tätigkeit", "Datum"}, {{ _
"Stunden", each List.Sum([Wert]), type number}}),
#"Sortierte Zeilen" = Table.Sort(#"Gruppierte Zeilen",{{"Datum", Order.Ascending}, {"Tä _
tigkeit", Order.Ascending}})
in
#"Sortierte Zeilen"

A11:H22 hat den TabellenNamen RawData und die eingefügte Spalte_C enthält das Montag-Datum der KW (-> Excel-Formeln)
Anzeige
AW: nachgefragt
23.06.2018 14:17:06
neopa
Hallo Günther,
... hast Du zu dieser Deiner Datei einen Link? Du weißt ja, bin bzgl. PQ noch in den Anfängen.
Kann mich aber erst Anfang der Woche damit beschäftigen.
Gruß Werner
.. , - ...
AW: Tabelle umwandeln
22.06.2018 20:15:08
Barbaraa
Mit einem Makro könnte es so gehen:

Sub Stundentabelle()
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Set wsTabelle = Sheets("Tabelle1")  ' Anpassen!
Set wsListe = Sheets("Tabelle2")    ' Anpassen!
Set rStart = wsTabelle.Range("C12") ' Anpassen!
With wsListe
'Ergebnisblatt vorbereiten
.Columns("A:D").ClearContents
.Range("A1").Value = "Woche"
.Range("B1").Value = "Tätigkeit"
.Range("C1").Value = "Tag"
.Range("D1").Value = "Stunden"
'Alle Stundenwerte durchlaufen
For lZeile = rStart.Row To rStart.Offset(0, -1).End(xlDown).Row
For lSpalte = rStart.Column To rStart.Offset(-1, 0).End(xlToRight).Column
'Passende Stundensumme suchen
For lSuchzeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1) Then
If .Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2) Then
If .Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte) Then
Exit For
End If
End If
End If
Next lSuchzeile
'In der Ergebnistabelle ...
If lSuchzeile > .Cells(.Rows.Count, 1).End(xlUp).Row Then
'Neue Stundensumme anlegen
.Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1)
.Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2)
.Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte)
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + wsTabelle.Cells(lZeile, lSpalte)
Else
'Zu bestehender Stundensumme addieren
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + wsTabelle.Cells(lZeile, lSpalte)
End If
Next lSpalte
Next lZeile
End With
End Sub
Allerdings ohne Umwandlung der Wochentage in Datum, außerdem scheinen die Summen in Deinem Beispiel nicht richtig zu sein.
Hilft das?
LGB
Anzeige
AW: ja, Erg.diff. hatte ich auch festgestellt owT
23.06.2018 14:18:46
neopa
Gruß Werner
.. , - ...
AW: Tabelle umwandeln
23.06.2018 16:36:20
Günther
@ Barbara: Schön kommentiert, was leider zu oft unter den Tisch fällt (ich nehme mich da insbesondere in Foren-Beiträgen nicht aus).
Und die Fehler habe ich (natürlich) auch festgestellt ... ;-)
@ Werner: Ich habe dir den Link mit ein paar Hinweisen per Mail zukommen lassen.
AW: Tabelle umwandeln
23.06.2018 17:00:15
Barbaraa
Hi Günter,
jaja, Kommentieren spart Zeit.
Was mich noch interessiert:
Wie kann man hier ein Mail oder eine PM versenden?
Kannst Du mir auch mal ein Mail schicken?
LGB
AW: Tabelle umwandeln
23.06.2018 17:45:16
Günther
Oh ja, Barbara,
das Selbstbewusstsein ("ich behalte doch so etwas ...") leidet rasch, wenn manch ein "Programmierer" nach 1 Jahr etwas in einem von ihm erstellten Projekt ändern muss und dann grübelt, "Warum habe ich denn dieses oder jenes an der Stelle gemacht?"
Ich glaube, dass in diesem Forum beides nicht (direkt) möglich ist. Der eine oder die andere kennt mich aus anderen Foren und weiß daher, wie ich per Mail zu erreichen bin. Oder ich habe die Mail-Adresse einmal hier in einem Beitrag genannt (wird zwar nicht so gerne gesehen, kann aber mal gewesen sein). Als dezenten Hinweis: Im Impressum meiner Website (PC-Hilfe-Nord.de hier mit dem "G.Mumme@…" statt des "Info@…") oder dem Impressum meines Blogs (Excel-ist-sexy.de) steht jeweils meine Mail-Adresse drin.
Kannst Du mir auch mal ein Mail schicken?
Damit meinst du wahrscheinlich DIE Mail, die ich Werner zugesandt habe; richtig? Da musst du mir erst einmal eine Mail senden, damit ich deine E-Mail kenne ... Dann mache ich das auch. ;-)
Beste Grüße aus dem Norden
Günther
Anzeige
AW: vorab ...
24.06.2018 08:39:17
neopa
Guten Morgen Günther,
... hier und heute schon mal meinen Dank an Dich.
Ich melde mich dann, wie bereits geschrieben, Anfang nächster Woche noch einmal dazu.
Einen schönen Sonntag Dir noch.
Gruß Werner
.. , - ...
AW: Tabelle umwandeln
25.06.2018 08:21:47
Klaus
Hallo an Alle,
vielen Dank für die schnellen Antworten.
Das Makro von Barbaraa funkt einwandfrei, genau was ich gesucht habe, muss ich nun nur noch in meine Originaldatei einbauen, diese hat ca. 2000 Zeilen(KW01 - 52).
Danke für den Hinweis mit dem Fehler: es sollte ja nur die Methodik zeigen, aber ja, beim nächsten mal muss ich besser aufpassen.
Gruß
Klaus
Anzeige
AW: Tabelle umwandeln
25.06.2018 14:45:22
Klaus
Hallo Barbaraa,
in der Beispieldatei funktioniert alles prima.
In der Originaldatei rennt er in den Debug-Modus und bricht ab.
Auszug aus Datei findest du hier
https://www.herber.de/bbs/user/122308.xlsm
Weißt du warum? Was passt denn nicht?
Vielen dank für deine Hilfe.
Gruß
Klaus
AW: Tabelle umwandeln
25.06.2018 20:49:38
Barbaraa
F32 vom "Hilfe"-Sheet legt im "Stunden_PZE_Tag"-Sheet eine neue Zeile mit Stunden an.
Der Stundenwert von F33 soll dazu gezählt werden, was aber nicht geht, weil das leider überraschenderweise ein Text ist.
Er hat zwar die Länge 0, ist aber ein Text. Keine Ahnung, wo der her kommt. Nun ist er eben da und es darf für diesen Fall diese Addition (Stunden + Text) nicht durchgeführt werden.
Das ist nun im folgenden Code berücksichtigt.
Sub Stundentabelle()
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Set wsTabelle = Sheets("Hilfe")  ' Anpassen!
Set wsListe = Sheets("Stunden_PZE_Tag")    ' Anpassen!
Set rStart = wsTabelle.Range("C12") ' Anpassen!
With wsListe
'Ergebnisblatt vorbereiten
.Columns("A:D").ClearContents
.Range("A1").Value = "Woche"
.Range("B1").Value = "Projekt-Name OEM1"
.Range("C1").Value = "Tag"
.Range("D1").Value = "Stunden"
'Alle Stundenwerte durchlaufen
For lZeile = rStart.Row To rStart.Offset(0, -1).End(xlDown).Row
For lSpalte = rStart.Column To rStart.Offset(-1, 0).End(xlToRight).Column
'Passende Stundensumme suchen
For lSuchzeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1) Then
If .Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2) Then
If .Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte) Then
Exit For
End If
End If
End If
Next lSuchzeile
'In der Ergebnistabelle ...
If lSuchzeile > .Cells(.Rows.Count, 1).End(xlUp).Row Then
'Neue Stundensumme anlegen
.Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1)
.Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2)
.Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte)
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
Else
'Zu bestehender Stundensumme addieren
If wsTabelle.Cells(lZeile, lSpalte)  vbNullString Then
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
End If
End If
Next lSpalte
Next lZeile
End With
End Sub

Das "Hilfe"-Sheet hat viele Nullstrings, die aber immer neu angelegt werden. Bei F33 soll ein solcher das erste Mal zu einer bestehenden Zahl dazu gezählt werden.
Hoffe, dass ich helfen konnte.
LGB
Anzeige
AW: Tabelle umwandeln
26.06.2018 07:36:46
Klaus
Hallo Barbaraa,
vielen Dank, funktioniert nun.
Gruß
Klaus
AW: Tabelle umwandeln
26.06.2018 10:56:30
Klaus
Hallo Barbaraa,
ich würde gerne nochmal deine Hilfe in Anspruch nehmen.
Das Makro dauert leider etwas lange, deshalb würde ich es gerne auf 1 Woche begrenzen. Wie lautet denn die If-Bedingung wenn ich mit einer Msg-Box die Woche vorher abfrage?
So würde ich es machen:
Dim woche As String
woche = InputBox("Welche Woche soll generiert werden?")
if woche = ... Then
Vielen Dank schon im Voraus
LG Klaus
AW: Tabelle umwandeln
26.06.2018 20:38:57
Barbaraa
Hi
der Code ist nun etwas beschleunigt und mit ein paar Zusatzfunktionen ausgestattet.
Wenn Du eine Wochenzahl bei Inputbox eingibst, wird eine Liste für diese eine Woche erzeugt.
Wenn diese Wochenzahl eine negative Zahl ist, wird diese Woche an die bestehende Liste angehängt. Das ist für den Fall, wenn Du eine Liste mit mehreren ausgewählten Wochen erstellen willst. Zum Beispiel Woche 3, 7 und 14. Erst 3 eingeben, dann nochmals starten mit -7, dann mit -14.
Wenn Du 0 eingibst, wird eine Liste mit allen Wochen erzeugt.
Sub StundentabelleSchneller()
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
Dim Woche                           'Abgefragte Woche
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Dim bProjWocheNeu   As Boolean      'Projektwochen neu anlgen
Set wsTabelle = Sheets("Hilfe")  ' Anpassen!
Set wsListe = Sheets("Stunden_PZE_Tag")    ' Anpassen!
Set rStart = wsTabelle.Range("C12") ' Anpassen!
Woche = InputBox("Welche Woche soll generiert werden?")
Woche = CInt(Woche)
With wsListe
If Woche >= 0 Then
'Ergebnisblatt vorbereiten, falls Woche grösser gleich Null
.Columns("A:D").ClearContents
.Range("A1").Value = "Woche"
.Range("B1").Value = "Projekt-Name OEM1"
.Range("C1").Value = "Tag"
.Range("D1").Value = "Stunden"
Else
Woche = -Woche
End If
'Alle Stundenwerte durchlaufen
For lZeile = rStart.Row To rStart.Offset(0, -1).End(xlDown).Row
If wsTabelle.Cells(lZeile, 1) = Woche Or Woche = 0 Then
'Passende Stundensumme suchen
bProjWocheNeu = True
For lSuchzeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1) Then
If .Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2) Then
bProjWocheNeu = False
Exit For
End If
End If
Next lSuchzeile
'In der Ergebnistabelle ...
For lSpalte = 3 To 7
If bProjWocheNeu Then
'Neue 5 Tageszeilen anlegen
.Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1)
.Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2)
.Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte)
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
Else
If wsTabelle.Cells(lZeile, lSpalte)  vbNullString Then
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
End If
End If
lSuchzeile = lSuchzeile + 1
Next lSpalte
End If
Next lZeile
End With
End Sub
Ausserdem ist die Erstellung der Liste nun schneller.
Nach der Erstellung der Montag-Zeile wird nicht erst vergeblich und zeitaufwändig nach der Dienstag-Zeile gesucht, die es ja mit Sicherheit noch nicht gibt, sondern gleich darunter geschrieben.
Das Erstellen dieser Beschleunigung dauerte ca. eine halbe Stunde und spart pro Durchgang zirka eine Sekunde. Das bedeutet, dass sich diese Zeit-Investition nach (30x60=) 1800 Durchläufen rechnet.
Konnte ich helfen?
LGB
Anzeige
AW: Tabelle umwandeln
27.06.2018 07:27:08
Klaus
Hallo Barbaraa,
super, vielen Dank.
Ein Fehler ist leider enthalten: wenn eine Woche schon vorhanden ist, dann werden die Stunden einfach nochmals addiert, die Woche sollte aber natürlich "überschrieben" werden (Zeilen löschen und neu unten anhängen)
Wegen schneller machen: auch hier Danke dafür (bei mir ist es mehr als nur eine Sekunde schneller) wäre es nicht auch sinnvoll, wenn das Makro die leeren Zellen direkt erst gar nicht erzeugt? Also nur Zeilen erzeugt, in denen auch Stunden enthalten sind? Im Moment habe ich ein zweites Makro laufen: sortieren leere nach unten und lösche diese.
LG Klaus
Anzeige
AW: Tabelle umwandeln
27.06.2018 19:22:01
Barbaraa
Kann ich nicht nachvollziehen:
Wenn die Woche 3 schon vorhanden ist, dann werden die Stunden einfach nochmals addiert, wenn Du "-3" eingibst.
Wenn Du aber "3" eingibst, wird die Tabelle neu angelegt.
LGB
AW: Tabelle umwandeln
27.06.2018 19:50:08
Barbaraa
"wäre es nicht auch sinnvoll, wenn das Makro die leeren Zellen direkt erst gar nicht erzeugt?"
Das war nicht gewünscht, also habe ich es auch nicht gemacht.
Leere Stundenzeilen weglassen bringt folgende Änderungen:
- Das Problem vom 25.6. 14:45 tritt nicht mehr auf, da Nullstrings nicht mehr addiert werden.
- Die Erstellung der Tabelle geht schneller, weil nur noch halb so gross.
Hier der Code:
Sub Stundentabelle0627()
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Set wsTabelle = Sheets("Hilfe")  ' Anpassen!
Set wsListe = Sheets("Stunden_PZE_Tag")    ' Anpassen!
Set rStart = wsTabelle.Range("C12") ' Anpassen!
With wsListe
'Ergebnisblatt vorbereiten
.Columns("A:D").ClearContents
.Range("A1").Value = "Woche"
.Range("B1").Value = "Projekt-Name OEM1"
.Range("C1").Value = "Tag"
.Range("D1").Value = "Stunden"
'Alle Stundenwerte durchlaufen
For lZeile = rStart.Row To rStart.Offset(0, -1).End(xlDown).Row
For lSpalte = rStart.Column To rStart.Offset(-1, 0).End(xlToRight).Column
If IsNumeric(wsTabelle.Cells(lZeile, lSpalte)) Then
'Passende Stundensumme suchen
For lSuchzeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1) Then
If .Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2) Then
If .Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte) _
Then
Exit For
End If
End If
End If
Next lSuchzeile
'In der Ergebnistabelle ...
If lSuchzeile > .Cells(.Rows.Count, 1).End(xlUp).Row Then
'Neue Stundensumme anlegen
.Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1)
.Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2)
.Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte)
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
Else
'Zu bestehender Stundensumme addieren
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
End If
End If
Next lSpalte
Next lZeile
End With
End Sub
Hoffe nun, das hilft.
Im Übrigen empfehle ich Dir, den Code ein wenig zu studieren, dann kannst Du Dir Deine Makros selbst anpassen.
LGB
Anzeige
AW: Tabelle umwandeln
28.06.2018 11:19:45
Klaus
Hallo Barbaraa
vielen Dank für deine Geduld mit mir, von den leeren Zellen war natürlich nie die Rede.
ich hab jetzt versucht, die beiden Lösungen zu verheiraten, mit Datumsauswahl und ohne die leeren Zellen. Bin kläglich gescheitert, mein VBA langt hierfür nicht, die ganzen Verschachtelungen sind zu viel für mich.
zum Fehler: ich baue eine Liste mit mehreren Wochen ("20", "-21", "-22", "-23", ...), nun ändert sich in Woche 22 nachträglich die Stunden, also erneut "-22" (ich möchte ja die restlichen Daten behalten), leider "überschreibt" er dann diese Woche nicht sondern addiert die Stunden(wenn Zeile schon vorhanden ist).
Ich möchte aber deine Zeit nicht sinnlos verschwenden, du hast schon so viel für mich getan, vielen dank dafür.
Anbei noch mein aktuelles Makro
Sub Stundentabelle()
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
Dim Woche                           'Abgefragte Woche
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Dim bProjWocheNeu   As Boolean      'Projektwochen neu anlgen
Set wsTabelle = Sheets("Hilfe")  ' Anpassen!
Set wsListe = Sheets("Hilfe2")    ' Anpassen! ->Umweg, da noch SVerweise in Tabelle Hilfe2  _
eingebaut sind und zugehöriges Datum berechnet wird
Set rStart = wsTabelle.Range("C12") ' Anpassen!
Woche = InputBox("Welche Woche soll generiert werden?")
Application.StatusBar = "Liste wird generiert"
Application.ScreenUpdating = False
Woche = CInt(Woche)
With wsListe
If Woche >= 0 Then
'Ergebnisblatt vorbereiten, falls Woche größer gleich Null
.Columns("A:D").ClearContents
.Range("A1").Value = "Woche"
.Range("B1").Value = "Projekt-Name OEM1"
.Range("C1").Value = "Tag"
.Range("D1").Value = "Stunden"
Else
Woche = -Woche
End If
'Alle Stundenwerte durchlaufen
For lZeile = rStart.Row To rStart.Offset(0, -1).End(xlDown).Row
If wsTabelle.Cells(lZeile, 1) = Woche Or Woche = 0 Then
'Passende Stundensumme suchen
bProjWocheNeu = True
For lSuchzeile = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1) Then
If .Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2) Then
bProjWocheNeu = False
Exit For
End If
End If
Next lSuchzeile
'In der Ergebnistabelle ...
For lSpalte = 3 To 7
If bProjWocheNeu Then
'Neue 5 Tageszeilen anlegen
.Cells(lSuchzeile, 1) = wsTabelle.Cells(lZeile, 1)
.Cells(lSuchzeile, 2) = wsTabelle.Cells(lZeile, 2)
.Cells(lSuchzeile, 3) = wsTabelle.Cells(rStart.Row - 1, lSpalte)
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
Else
If wsTabelle.Cells(lZeile, lSpalte)  vbNullString Then
.Cells(lSuchzeile, 4) = .Cells(lSuchzeile, 4) + _
wsTabelle.Cells(lZeile, lSpalte)
End If
End If
lSuchzeile = lSuchzeile + 1
Next lSpalte
End If
Next lZeile
End With
'ab hier meine Ergänzungen
Sheets("Hilfe2").Activate
Call löschen_leer
'Sheets("Hilfe").Visible = xlVeryHidden
'Sheets("Hilfe2").Visible = xlVeryHidden
Sheets("Stunden_PZE_Tag").Select
Dim letzteZeile As Long
letzteZeile = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Range("A1:D1").Select
Selection.AutoFill Destination:=Range("A1:D" & letzteZeile)
'sortieren nach Datum
Range("A1:K" & letzteZeile).Sort Key1:=Range("E2"), Order1:=xlAscending, Key2:=Range("I2"),  _
Order2:=xlAscending, Header:=xlGuess
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Gruß
Klaus
AW: Tabelle umwandeln
28.06.2018 19:35:18
Barbaraa
Hi Klaus,
ohne Deinen Code untersucht zu haben, hier eine Möglichkeit der Erstellung der Stundenliste in Null Komma fast nix Millisekunden:

Sub Stundentabelle0628()
Dim aTabelle()      As Variant
Dim aListe()        As Variant
'Ausgangsblatt
Dim wsTabelle       As Worksheet    'Ausgangsblatt
Dim rStart          As Range        'Erste Stundenzelle
Dim lZeile          As Long         'Laufende Zeile
Dim lSpalte         As Long         'Laufende Spalte
'Ergebnisblatt
Dim wsListe         As Worksheet    'Ergebnisblatt
Dim lSuchzeile      As Long         'Eintragszeile
Set wsTabelle = Sheets("Hilfe")  ' Anpassen!
Set wsListe = Sheets("Stunden_PZE_Tag")    ' Anpassen!
Set rStart = wsTabelle.Range("C12") ' Anpassen!
aTabelle = rStart.CurrentRegion.Value
ReDim aListe(1 To 4, 0)
aListe(1, 0) = "Woche"
aListe(2, 0) = "Projekt-Name OEM1"
aListe(3, 0) = "Tag"
aListe(4, 0) = "Stunden"
For lZeile = 2 To UBound(aTabelle, 1)
For lSpalte = 3 To 7
If aTabelle(lZeile, lSpalte)  "" Then
For lSuchzeile = 1 To UBound(aListe, 2)
If aListe(1, lSuchzeile) = aTabelle(lZeile, 1) Then
If aListe(2, lSuchzeile) = aTabelle(lZeile, 2) Then
If aListe(3, lSuchzeile) = aTabelle(1, lSpalte) Then
aListe(4, lSuchzeile) = aListe(4, lSuchzeile) + _
aTabelle(lZeile, lSpalte)
Exit For
End If
End If
End If
Next lSuchzeile
If lSuchzeile > UBound(aListe, 2) Then
ReDim Preserve aListe(1 To 4, 0 To lSuchzeile)
aListe(1, lSuchzeile) = aTabelle(lZeile, 1)
aListe(2, lSuchzeile) = aTabelle(lZeile, 2)
aListe(3, lSuchzeile) = aTabelle(1, lSpalte)
aListe(4, lSuchzeile) = aTabelle(lZeile, lSpalte)
End If
End If
Next lSpalte
Next lZeile
wsListe.Range(Cells(1, 1), _
Cells(1 + UBound(aListe, 2) - LBound(aListe, 2), _
1 + UBound(aListe, 1) - LBound(aListe, 1))) _
= Application.Transpose(aListe)
End Sub
Funktioniert das?
LGB
AW: Tabelle umwandeln
28.06.2018 23:17:16
Barbaraa
Nachtrag:
Das Makro, das ich Dir heute abend reingestellt habe, funktioniert nur, wenn das Blatt mit der Stundenliste aktiv ist. LGB
AW: Tabelle umwandeln
29.06.2018 08:31:32
Klaus
Hallo Barbaraa,
Wahnsinn, wow, du hast nicht übertrieben :-)
Wie geht das denn?
Kann ich dich irgendwie überreden meine anderen ewig dauernden Makros (teilweise über 20 Minuten) mal zu durchleuchten?
Vielen Dank soweit, du hast mir extrem geholfen :-)
Gruß
Klaus
AW: Tabelle umwandeln
29.06.2018 08:53:53
Barbaraa
Warum geht das jetzt plötzlich schneller?
Weil alles in ein array gepackt, dieses dann auf selben Weg verarbeitet wurde und das Ergebnis in ein anderes array geschrieben wurde.
Die Interaktion mit dem Excel-sheet ist anfangs das Auslesen in ein array und am Ende die Rückübertragung des Ergebnis-arrays in das andere Sheet.
In den bisherigen Makros war jedes Lesen und Schreiben eine solche Interaktion. Und die dauern lange.
Könnte dich per mail kontaktieren. Mach schnell, denn bald ist dieses Thema im Forum weg (ist schon ganz unten).
LGB
AW: Tabelle umwandeln
29.06.2018 11:37:54
Klaus
Hallo Barbaraa
puttekau1912@arcor.de
Danke
AW: man kann trotzdem noch antworten ...
04.07.2018 15:58:24
neopa
Hallo Barbaraa,
... wie Du aus meinen hiesigen Beitrag entnehmen kannst.
Dies geht aber nur solange, wie ein entsprechender zu beantwortender Beitrag noch aus der BEITRAGSLISTE steht. Momentan ist das der Fall für Beiträge vom 28.06.18 Nachmittag. Man hat nur ein Problem, wenn man (wie ich) die E-Mail-Benachrichtigung hier im Forum deaktiviert hat. Man muss dann allerdings etwas mühselig auf Suche gehen und das mache ich wiederum ganz selten.
In diesem Fall hab ich es mal getan, weil mir bei der gestern erfolgten Testung Deiner Makroergebnisse aufgefallen war, dass Du beim Ergebnislisting voraussetzt, dass die auszuwertenden Datenwerte nach KW aufwärts sortiert sind und auch die Wochentage direkt übernommen worden sind und nicht das Datum des Tages (was ich in meiner Formellösung getan habe und was auch in der PQ-Lösung von Günther integriert ist).
Gruß Werner
.. , - ...

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige