midnightautomatic
Goto Top

Daten zeilenweise aus Tabellenblättern extrahieren und in ein anderes Tabellenblatt schreiben

Ich versuche eine Auswertung aus mehreren Tabellenblättern, die z.T. dynamisch generiert werden, sich ändern und deren Inhalte wieder gelöscht werden. Die Auswertung sollte jedoch alle extrahierten Daten enthalten.

Hallo,
ich möchte aus zwei Tabellenblättern, automatisch Daten extrahieren und in ein drittes schreiben. Konkret sieht das so aus, dass nur Zeilen, die einen Eintrag in Spalte D haben, fortlaufend auf das dritte Blatt kopiert werden sollen. Dazu soll jede Änderung in der Spalte D sofort erkannt werden und die Zeile anschließend kopiert werden.
Wenn ich das nötige Makro mit:

Private Sub Worksheet_Change(ByVal Target As Range)
Call Makro
End Sub

in den Worksheets aufrufe, passiert das zwar sofort, aber alle Daten werden neu übernommen und nicht nur die letzte Änderung. Problematisch ist für mich auch, die fortlaufende Liste. Zum Teil werden momentan alte Zeilen von neuen überschrieben oder ich habe doppelte.

Wie muss der korrekte Ansatz lauten?

Hat jemand eine praktische Idee?

Gruß

Alexander

Content-ID: 151781

Url: https://administrator.de/forum/daten-zeilenweise-aus-tabellenblaettern-extrahieren-und-in-ein-anderes-tabellenblatt-schreiben-151781.html

Ausgedruckt am: 23.12.2024 um 14:12 Uhr

midnightautomatic
midnightautomatic 26.09.2010 um 18:07:45 Uhr
Goto Top
Hi!

Hier noch das Makro, das ich dafür zurzeit einsetze:
Sub Auswertmakro()
Dim Zeile As Long, Blattname_alt As String, _
Wiederholungen As Long
Application.ScreenUpdating = False
Blattname_alt = "Datenquelle" 'ActiveSheet.Name  

Sheets("zu bestellen").Select  
    Cells.Select
    Selection.ClearContents

Sheets(Blattname_alt).Activate
For Wiederholungen = 1 To 6000
If Cells(Wiederholungen, 4) <> "" Then  
Zeile = Sheets("zu bestellen").Range("D65536"). _  
End(xlUp).Offset(1, 0).Row
Rows(Wiederholungen).Copy _
Sheets("zu bestellen").Cells(Zeile, 1)  
End If
Next
End Sub
Funktioniert abgesehen von den besagten Problemen leider auch nur für ein Tabellenblatt.
Gruß
Alexander
76109
76109 26.09.2010 um 19:15:28 Uhr
Goto Top
Hallo Alexander!

Zu ersteinmal ist diese Funktion bei mehreren Blättern besser geeignet und der Code wird in "DieseArbeitsmappe" eingefügt:
Const Sheet1 = "Daten1"  
Const Sheet2 = "Daten2"  
Const Spalte = 4

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh Is Sheets(Sheet1) Or Sh Is Sheets(Sheet2) Then
        '.................  
    End If
End Sub
Das Problem bei solchen Erreignis-Funktionen ist, dass diese auch bei Aktivitäten ausgelöst werden, die sich auf mehrere Zellen beziehen. D.h. je nach Aktion werden hier nicht nur einzelne Zell-Adressen, sondern auch Bereichs-Adressen übergeben z.B. "$D$4" oder "$A2$:$G$8" sowas in der Art, die z.B. auch die Adressen "$D$2:$D$8 beinhaltet. Um also Fehler zu vermeiden, wird Dir nix anderes übrigbleiben, als bei einer Änderung stets den gesamten Inhalt zu exportieren.

Gruß Dieter
76109
76109 26.09.2010 um 19:31:33 Uhr
Goto Top
Hallo nochmal!

Du könntest auch diesen Code verwenden, der zumindest ermittelt, ob sich in der Spalte D etwas geändert hat:
Const Sheet1 = "Daten1"  
Const Sheet2 = "Daten2"  
Const Spalte = 4

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim TestSpalteD As Range
    
    If Sh Is Sheets(Sheet1) Or Sh Is Sheets(Sheet2) Then
        Set TestSpalteD = Application.Intersect(Target, Range("D:D"))  
        
        If Not TestSpalteD Is Nothing Then
            '....Daten exportieren.....  
        End If
    End If
End Sub
76109
76109 28.09.2010 um 11:21:31 Uhr
Goto Top
Hallo Alexander!

Du könntest diesen Code mal testen. Allerdings funktioniert der nur, wenn die Daten-Sheets eine Überschrift-Zeile in Zeile 1 enthalten.

Konstanten entsprechend anpassen
Const Sheet1 = "Daten1"  
Const Sheet2 = "Daten2"  
Const Sheet3 = "Bestellen"  

Const FilterRange = "D:D"       'Spalte D mit Leer/Inhalt  
Const CopyZeileVon = 2          'Spalte D kopieren ab Zeile ?  

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Wks As Worksheet, TestSpalteD As Range, CopyZeileBis As Long, PasteZeileAb As Long
    
    If Sh Is Sheets(Sheet1) Or Sh Is Sheets(Sheet2) Then
        Set TestSpalteD = Application.Intersect(Target, Range(FilterRange))
        
        If Not TestSpalteD Is Nothing Then
            Set Wks = Sheets(Sheet3)
            
            Application.ScreenUpdating = False
            
            Wks.Cells.Clear
            
            With Sheets(Sheet1)
                .Rows(1).Copy Wks.Rows(1)
                .Range(FilterRange).AutoFilter Field:=1, Criteria1:="<>", VisibleDropDown:=False  
                 CopyZeileBis = .Cells(.Rows.Count, "D").End(xlUp).Row  
                 PasteZeileAb = CopyZeileVon
                .Rows(CopyZeileVon & ":" & CopyZeileBis).Copy Wks.Rows(PasteZeileAb)  
                .AutoFilterMode = False
            End With
                
            With Sheets(Sheet2)
                .Range(FilterRange).AutoFilter Field:=1, Criteria1:="<>", VisibleDropDown:=False  
                 CopyZeileBis = .Cells(.Rows.Count, "D").End(xlUp).Row  
                 PasteZeileAb = Wks.Cells(Wks.Rows.Count, "D").End(xlUp).Row + 1  
                .Rows(CopyZeileVon & ":" & CopyZeileBis).Copy Wks.Rows(PasteZeileAb)  
                .AutoFilterMode = False
            End With
            Application.ScreenUpdating = True
        End If
    End If
End Sub

Gruß Dieter

[edit] kleine Änderung (funktional aber wie vorher) [/edit]
midnightautomatic
midnightautomatic 28.09.2010 um 18:21:23 Uhr
Goto Top
Hi Dieter!
Das habe ich eigentlich auch schon fast hinbekommen, hatte aber Unregelmäßigkeiten, die ich mir nicht erklären konnte. Deine Lösung gefällt mir sehr gut, weil auch die Performance vermutlich besser ist. Vielen Dank!
Grüße
Alexander
midnightautomatic
midnightautomatic 28.09.2010 um 18:45:58 Uhr
Goto Top
Hi Dieter!
Problematisch ist für mich allerdings noch, dass in Tabelle „Daten2“ die bekannte Suchfunktion aus dem anderen Beitrag verwendet werden soll. Jetzt scheitern leider alle Ansätze außer Deiner ComboBox, weil Tabellenblatt „Daten2“, wo die Suche ausgeführt wird, ja jedes Mal wieder gelöscht wird. Es wäre daher sinnvoll die Daten in „bestellen2“ fortlaufend zu sammeln, zumindest was die Auswertung aus dem Sheet „Daten2“ angeht.

Wenn es dann wirklich auf die Bestellung zugeht, müsste „bestellen“ erst sortieren und gegeben falls Zeilen zusammenfassen. Dann hätte man eine Komplettlösung, beinhaltet aber schon die nächste Baustelle.
Viele Grüße
Alexander
76109
76109 28.09.2010 um 19:09:27 Uhr
Goto Top
Hallo Alexander!

Zitat von @midnightautomatic:
Das habe ich eigentlich auch schon fast hinbekommen, hatte aber Unregelmäßigkeiten, die ich mir nicht erklären
konnte. Deine Lösung gefällt mir sehr gut, weil auch die Performance vermutlich besser ist. Vielen Dank!
Die Performance sollte meines Erachtens turbomäßig sein.

Zu Deiner zweiten Antwort habe ich im Moment keinen Plan und muss ich mir erst nochmal anschauen. Aber grundsätzlich besteht ja die Möglichkeit, die Aktualisierung während der Ausführung anderer Aktivitäten, wie beispielsweise der Suchfunktion, bis zu dessen Beendigung zu deaktivieren. Wäre jetzt mein erster Gedanke dazuface-wink

Gruß Dieter
midnightautomatic
midnightautomatic 28.09.2010 um 22:17:33 Uhr
Goto Top
Hallo Dieter!

Aber grundsätzlich besteht ja die Möglichkeit, die Aktualisierung während der Ausführung anderer Aktivitäten, wie beispielsweise der Suchfunktion, bis zu dessen Beendigung zu deaktivieren. Wäre jetzt mein erster Gedanke dazu

Das dürfte keine Rolle spielen. Am Ende zählen für mich nach wie vor die Zeilen, die eine Eintragung in der Spalte D, nennen wir sie Menge, haben, denn diese landen dann schließlich auf dem Bestellformular bzw. auf dem Tabellenblatt "bestellen". Problematisch ist eher, dass nach erfolgter Suche meine Eintragung in Spalte D und damit die Übernahme in Tabellenblatt "bestellen" flöten geht, sobald ich eine neue Suche ausführe face-surprise
midnightautomatic
midnightautomatic 28.09.2010 um 22:23:20 Uhr
Goto Top
midnightautomatic
midnightautomatic 28.09.2010 um 22:41:48 Uhr
Goto Top
Hi Dieter!
Bisher habe ich in "bestellen" die Artikel, Artikelnummer, Preis und Gesamtpreis gesammelt. Die Spalte wird erst dann berücksichtigt, wenn in Menge eine Eintragung gemacht wurde. Menge müsste man dann in die korrespondierende Spalte von "Daten1" kopieren, damit diese auch in der nächsten Suche berücksichtigt wird. Das sprengt aber hier den Rahmen. Ich mache dann einen extra Thread.
Der erfolgte Eintrag in Spalte D und damit die zugehörige Zeile darf auch nach der nächsten Suche nicht verlorengegangen sein. Das ist der Kern.

Grüße

Alexander