Excel Abfrage und Auswertung mit VBA/ Makro?!

Question

Hallo,

folgende Situation:

Ich habe mehrere EXCEL Sheets mit ca. 12k Datensätzen... aus diesen Datensätzen brauch ich allerdings pro Sheet nur einen Bruchteil.

Ich hab mir eine Theoretische Lösung überlegt, schaffe diese allerdings nicht umzusetzen.

Die Tabelle ist wie folgt aufgebaut:

A B C D E F G H I
Beginn 02.11.2010 00:00:00
Ende 02.11.2010 00:30:00

dann exakt 73 Zeilen Drunter befindet sich in I der Begriff "MC1200"
darunter folgt dann eine Auflistung von Zahlen.
137
145
.....
Meine Idee nun:
Man macht eine Schleifenabfrage mit den Kriterien

wenn A =" Beginn" , dann springe auf C und kopiere dieses Feld C auf neue Datenblatt

>> dann rücke 73 felder runter bis "MC1200" kommt.
danach prüfe jede zeile unter "MC1200" und gib diese Zahlen auf den neuen Datenblatt aus bis ein Leerfeld kommt.

In meinen Sheet werden alle Messungen erfasst im halben Stundentakt.. d.h. 00:30:00 - 01:00:00, 01:00:00 - 01:30:00 bis 23:00:00 - 00:00:00 (Folgetag)

Am Ende sollte quasi:

Start
Ende
Werte

rauskommen und die Zeiten alle nebeneinander.

Ich hoffe jemand kann sich mir annehmen und mir helfen :)

Answer 1

achja,

hab mit diesen Schnippsel probiert - aber bin nicht im Stande es anzupassen..

StandardModule: basMain

Sub FilternUndKopieren()
Application.ScreenUpdating = False
With Range("A1")
.AutoFilter Field:=3, Criteria1:="<10"
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Kleiner10").Range("A1")
.AutoFilter Field:=3, Criteria1:="<50"
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Kleiner50").Range("A1")
.AutoFilter Field:=3, Criteria1:=">=50"
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Andere").Range("A1")
End With
ActiveSheet.AutoFilterMode = False
End Sub

Answer 2

hallo charlie brown :-))

schick mir eine mustertabelle zu :-)

oberley@t-online.de

gruss nighty

Answer 3

keiner was parat :-/

Answer 4

hi charlie brown :-)

um eine vernuenftige laufzeit zu erreichen muss man sich schon gedanken machen und einiges testen,draengelei ist da nicht so angebracht

gruss nighty

Answer 5

hi charlie brown :-)

probier mal

zur zeit auf 1 worksheet bezogen

gruss nighty

p.s.
durch draengelei erfolgten keine zeitmessungen und optimierungen

Option Explicit
'quelldaten sind worksheets(1)
'ziel ist worksheets(2)
Sub Auswertung()
Worksheets(1).Activate
Dim SpalteAB() As Variant
Dim SpalteI() As Variant
'um eine vernuenftige laufzeit zu erhalten,ist hier eine angabe der maxzeilen ,wie auch maxspalten fuer die ausgabe anzugeben
'eine abtastung die recht einfach zu gestalten waere wuerde die laufzeit enorm verlaengern
'zur zeit sind 10 000 zeilen max wie 100 spalten max,bei der ausgabe
'die selben daten auch letzte zeile anpassen
Dim NWert(10000, 100) As Variant
Dim Zelle As Long, Zwert As Long, NwertIndex As Long, werte As Long
Zwert = 1
SpalteAB() = Range("A2:B" & Cells(Rows.Count, 9).End(xlUp).Row)
SpalteI() = Range("I2:I" & Cells(Rows.Count, 9).End(xlUp).Row)
For Zelle = LBound(SpalteAB()) To UBound(SpalteAB())
If UCase(SpalteAB(Zelle, 1)) = "BEGINN" Then
NWert(NwertIndex, 1) = SpalteAB(Zelle, 2)
NWert(NwertIndex, 0) = "Beginn"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 1) = SpalteAB(Zelle + 1, 2)
NWert(NwertIndex, 0) = "Ende"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 0) = "Wert"
For werte = Zelle + 78 To UBound(SpalteAB())
NWert(NwertIndex, Zwert) = SpalteI(werte, 1)
Zwert = Zwert + 1
If SpalteI(werte, 1) = "" Then Exit For
Next werte
Zwert = 1
NwertIndex = NwertIndex + 1
End If
Next Zelle
Worksheets(2).Activate
Range(Cells(2, 1), Cells(10000, 101)) = NWert()
End Sub

Answer 6

hi charlie brown :-)

ein wenig optimiert

gruss nighty

Option Explicit

Sub Auswertung()
Call EventsOn
Worksheets(1).Activate
Dim SpalteAB() As Variant
Dim SpalteI() As Variant
Dim NWert(10000, 100) As Variant
Dim Zelle As Long, Zwert As Long, NwertIndex As Long, werte As Long
Zwert = 1
SpalteAB() = Range("A2:B" & Cells(Rows.Count, 9).End(xlUp).Row)
SpalteI() = Range("I2:I" & Cells(Rows.Count, 9).End(xlUp).Row)
For Zelle = LBound(SpalteAB()) To UBound(SpalteAB())
If UCase(SpalteAB(Zelle, 1)) = "BEGINN" Then
NWert(NwertIndex, 1) = SpalteAB(Zelle, 2)
NWert(NwertIndex, 0) = "Beginn"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 1) = SpalteAB(Zelle + 1, 2)
NWert(NwertIndex, 0) = "Ende"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 0) = "Wert"
For werte = Zelle + 78 To UBound(SpalteAB())
NWert(NwertIndex, Zwert) = SpalteI(werte, 1)
Zwert = Zwert + 1
If SpalteI(werte, 1) = "" Then
Exit For
Zelle = Zelle + 78
End If
Next werte
Zwert = 1
NwertIndex = NwertIndex + 1
End If
Next Zelle
Worksheets(2).Activate
Range(Cells(2, 1), Cells(10000, 101)) = NWert()
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 7

hi :-)

ops korrigiert

gruss nighty

Option Explicit

Sub Auswertung()
Call EventsOff
Worksheets(1).Activate
Dim SpalteAB() As Variant
Dim SpalteI() As Variant
Dim NWert(10000, 100) As Variant
Dim Zelle As Long, Zwert As Long, NwertIndex As Long, werte As Long
Zwert = 1
SpalteAB() = Range("A2:B" & Cells(Rows.Count, 9).End(xlUp).Row)
SpalteI() = Range("I2:I" & Cells(Rows.Count, 9).End(xlUp).Row)
For Zelle = LBound(SpalteAB()) To UBound(SpalteAB())
If UCase(SpalteAB(Zelle, 1)) = "BEGINN" Then
NWert(NwertIndex, 1) = SpalteAB(Zelle, 2)
NWert(NwertIndex, 0) = "Beginn"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 1) = SpalteAB(Zelle + 1, 2)
NWert(NwertIndex, 0) = "Ende"
NwertIndex = NwertIndex + 1
NWert(NwertIndex, 0) = "Wert"
For werte = Zelle + 78 To UBound(SpalteAB())
NWert(NwertIndex, Zwert) = SpalteI(werte, 1)
Zwert = Zwert + 1
If SpalteI(werte, 1) = "" Then
Exit For
Zelle = Zelle + 78
End If
Next werte
Zwert = 1
NwertIndex = NwertIndex + 1
End If
Next Zelle
Worksheets(2).Activate
Range(Cells(2, 1), Cells(10000, 101)) = NWert()
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 8

Hallo nighty,


vielen Danke schonmal für deine Lösung - bekomme allerdings immer einen Laufzeitfehler `9` - Index außerhalb des gültigen Bereichs... was heisst das :D

Answer 9

hi :-)

mit deiner beispieldatei war es lauffaehig

gruss nighty

Answer 10

hi :-)

dann entsprach die musterdatei nicht der originalen datei

gruss nighty