Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
964to968
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
964to968
964to968
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Messdaten zusammenfassen

Messdaten zusammenfassen
06.04.2008 09:15:00
Sibylle
Guten Morgen,
die Mappe Messdaten enthält 8 Tabellen.
In den Tabellen 1 bis 7 werden Messdaten eingelesen, immer ab Zelle A3 nach unten, zwischen 5000 und 8000 Daten je Tabelle.
Diese sollen nun automatisch in Tabelle8 für die Auswertung übernommen werden.
Wie könnte man dies per VBA machen?
Gruß
Sibylle

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Messdaten zusammenfassen
06.04.2008 09:27:00
Josef
Hallo Sibylle,
füge diesen Code in ein allgemeines Modul ein.
Sub Zusammenfassung()
Dim objWS As Worksheet
Dim iIndex As Integer, lngLast As Long, lngR As Long

lngR = 3

Set objWS = Sheets("Tabelle8") 'Name der Zusammenfassungstabelle
objWS.Range("A3:A" & Rows.Count).ClearContents

For iIndex = 1 To 7
    With Sheets("Tabelle" & iIndex)
        lngLast = Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row)
        .Range("A3:A" & lngLast).Copy objWS.Cells(lngR, 1)
        lngR = lngR + lngLast - 2
    End With
Next

Set objWS = Nothing
End Sub


Gruß Sepp



Anzeige
AW: Messdaten zusammenfassen
06.04.2008 09:41:00
Sibylle
Hallo Sepp,
ganz herzlichen Dank. Der Test hat wunderbar geklappt.
Ich freue mich sehr über diese Lösung. Danke.
Eine Frage dazu habe ich noch:
Wenn die Anzahl der Messdaten 65536 übersteigen würde, wie würdest Du dann vorgehen?
Leider muss ich jetzt für ein paar Stunden weg. Vielleicht werde ich heute Abend mit einem Vorschlag überrascht.
Gruß
Sibylle

AW: Messdaten zusammenfassen
06.04.2008 09:44:00
Josef
Hallo Sibylle,
entweder man schreibt die Restlichen Daten in ein neues Tabellenblatt, oder sie werden in Tabelle8 in einer anderen Spalte fortgeschrieben.

Gruß Sepp



Anzeige
AW: Messdaten zusammenfassen
06.04.2008 10:05:24
Josef
Hallo Sibylle,
hier werden die Daten auf einer neuen Tabelle fortgeschrieben.
Sub Zusammenfassung()
Dim objWS As Worksheet
Dim iIndex As Integer, lngLast As Long, lngR As Long
Dim lngS As Long

lngR = 3

Set objWS = Sheets("Tabelle8") 'Name der Zusammenfassungstabelle
objWS.Range("A3:A" & Rows.Count).ClearContents

For iIndex = 1 To 7
    With Sheets("Tabelle" & iIndex)
        lngLast = Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row)
        If lngR + lngLast - 2 > Rows.Count Then
            lngS = Rows.Count - lngR + 3
            .Range("A3:A" & lngS).Copy objWS.Cells(lngR, 1)
            Set objWS = ThisWorkbook.Worksheets.Add(after:=objWS)
            lngR = 3
            .Range(.Cells(lngS + 1, 1), .Cells(lngLast, 1)).Copy objWS.Cells(lngR, 1)
        Else
            .Range("A3:A" & lngLast).Copy objWS.Cells(lngR, 1)
        End If
        lngR = lngR + lngLast - 2
    End With
Next

Set objWS = Nothing
End Sub



Gruß Sepp



Anzeige
Korrektur
06.04.2008 10:09:01
Josef
Hallo nochmal,
war noch ein Fehler drin.
Sub Zusammenfassung()
Dim objWS As Worksheet
Dim iIndex As Integer, lngLast As Long, lngR As Long
Dim lngS As Long

lngR = 3

Set objWS = Sheets("Tabelle8") 'Name der Zusammenfassungstabelle
objWS.Range("A3:A" & Rows.Count).ClearContents

For iIndex = 1 To 7
    With Sheets("Tabelle" & iIndex)
        lngLast = Application.Max(3, .Cells(Rows.Count, 1).End(xlUp).Row)
        If lngR + lngLast - 2 > Rows.Count Then
            lngS = Rows.Count - lngR + 3
            .Range("A3:A" & lngS).Copy objWS.Cells(lngR, 1)
            Set objWS = ThisWorkbook.Worksheets.Add(after:=objWS)
            lngR = 3
            .Range(.Cells(lngS + 1, 1), .Cells(lngLast, 1)).Copy objWS.Cells(lngR, 1)
            lngR = lngR + lngS - 2
        Else
            .Range("A3:A" & lngLast).Copy objWS.Cells(lngR, 1)
            lngR = lngR + lngLast - 2
        End If
    End With
Next

Set objWS = Nothing
End Sub


Gruß Sepp



Anzeige
Tausend Dank
06.04.2008 17:52:09
Sibylle
Hallo Sepp,
das ist ja wie bei einem Geburtstag ...
Ich danke Dir herzlich für Deine Programme. Mangels Daten werde ich erst morgen testen können. Ich bin jedoch ganz sicher, dass Dein Programm funktionieren wird. Damit wird in Zukunft viel nervraubende Arbeit vermieden.
Ich wünsche Dir noch einen recht schönen Abend. Vielen Dank.
Gruß
Sibylle

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige