Excel Tabelle mit VBA auswerten

Computer: Software & Programmierung Visual Basic
#1

Hallo,

ich möchte eine Excel Tabelle auswerten.
Die Tabelle „Eingabe“ hat 93 Spalten. Die erste Spalte beinhaltet ein Datum, es kommt jedoch mehrfach das gleiche Datum vor. Der restliche Inhalt der Tabelle ist größtenteils Text, in manchen Spalten sind jedoch auch Zahlen.
Die Anzahl der Zeilen ist nicht festgelegt, sondern soll durch zwei vorgegebene Daten (von Tag xxx bis Tag yyy) definiert werden. Da ein Datum mehrfach (sortiert) vorkommt, würde ich gerne mit dem Startdatum die Spalte A von oben beginnend durchsuchen um zu der Zeile der ersten Übereinstimmung zu kommen. Für die Zeile des Enddatums würde ich die Spalte von unten beginnend durchsuchen um auch hier zu der Zeile der ersten Übereinstimmung zu kommen bzw. zu der letzten Zeile mit dem entsprechenden Datum.

Meine Idee ist es nun, die dann definierte Tabelle („Zeile_Startdatum1:Zeile_Enddatum93“) in ein Array einzulesen, neu zu sortieren und dann in das Tabellenblatt „Auswertung“ zu schreiben. Dort sollen dann die Spalten über ZÄHLENWENN, ausgezählt werden.

Um die Daten aus dem Tabellenblatt einzulesen, zu sortieren und wieder auszugeben habe ich folgenden Code im Netz gefunden. (die Kommentare sind von mir, wie ich denke, dass ich den Code ungefähr anpassen müsste) Eine erneute Sortierung ist Notwendig, da die auszuwertenden Daten durch weitere vorgegebene Punkte reduzuiert werden können. Ich würde die sich ergebenden Datentabelle entsprechend öfter auslesen lassen, bis nur noch die Daten übrig bleiben, die ich letztenendes auszählen möchte.

Sub InArrOutArr()
Dim rng As Range
Dim arr As Variant 'Dim Zeile_Startdatum, Zeile_Enddatum As Integer
Application.ScreenUpdating = False
Set rng = Range(„A1“).CurrentRegion 'Worksheets(„Eingabe“).Range(Cell(Zeile_Startdatum, 1), Cell(Zeile_Enddatum, 93))
arr = rng.Value
Workbooks.Add
Range(„A1“).Range(rng.Address).Value = arr 'Range(Cell(Zeile_Startdatum, 1)
Range(„A1“).Sort key1:=Range(„A1“), _ 'je nachdem, nach welcher Spalte sortiert werden soll
order1:=xlAscending, header:=xlNo
arr = Range(„A1“).CurrentRegion.Value
ActiveWorkbook.Close savechanges:=False
With Worksheets(„Tabelle2“)
.Range(rng.Address).Value = arr '.Worksheets(„Ausgabe“).Range…
.Select
End With
Application.ScreenUpdating = True
End Sub

Ich habe nun überlegt, das Durchsuchen der Spalte mit dem Datum mit einer „Do - Loop … Until“ Scheife zu machen. Ich habe nun zwar schon einiges versucht zu finden bzw. mir zu erklären, allerdings komme ich nicht mit der Formulierung des Codes und der Verknüpfung zum Einlesen und Ausgeben des Arrays nicht zurecht.

Viele Dank für Hilfe

Gruß Axel

#2

Die Tabelle „Eingabe“ hat 93 Spalten. Die erste Spalte
beinhaltet ein Datum, es kommt jedoch mehrfach das gleiche
Datum vor. Der restliche Inhalt der Tabelle ist größtenteils
Text, in manchen Spalten sind jedoch auch Zahlen.
Die Anzahl der Zeilen ist nicht festgelegt, sondern soll durch

Hi Axel,
ich verstehe nicht wenn du im Text sagst du willst ein Blatt einfügen, daß du das mit Workbook.Add probierst?

Probier mal nachfolgenden Code, er funktioniert am nachstehender Tabelle in Tabelle1.
Wenn es um Datum in A geht wird man wohl noch CDate() miteinbauen müssen, auch ansonsten ist er nur ein Ansatz.

A B C D E F G...
1 e 
1 
1 f 
1 f 
1 f 
1 f 
1 g j 
1 k j 
2 
2 k 
2 k 
2 k 
2 k k
2 
2 
2 k k 
2 
2 k 
2 k
2 k 
2 k
2 k 
2 k
3 ,- 
3 
3 jj

Der Code:

Option Explicit

Sub tt()
Dim Eingabe, Von, Bis, ws, wsA
Application.DisplayAlerts = False
For Each ws In Worksheets
 If ws.Name = "Auswertung" Then
 ws.Delete
 Exit For
 End If
Next ws
Application.DisplayAlerts = True
Eingabe = InputBox("Datum")
If Eingabe = "" Then Exit Sub
Worksheets.Add
ActiveSheet.Name = "Auswertung"
Set wsA = Worksheets("Auswertung")
wsA.Cells.Clear
With Worksheets("Tabelle1")
 .Activate
 Von = Application.WorksheetFunction.Match(CInt(Eingabe), .Range("A1:A1000"), 0)
 Bis = Von
 While .Cells(Bis + 1, 1) = CInt(Eingabe)
 Bis = Bis + 1
 Wend
 .Range(Cells(Von, 1), Cells(Bis, 93)).Copy Destination:=wsA.Range("A1")
End With
End Sub

Gruß
Reinhard

#3

Hallo Reinhard,

das mit dem Einfügen eines neuen Worksheets ist natürlich nicht nötig. Denn es gibt natürlich schon beide Tabellenblätter.
Soweit ich die Beschreibung zu dem Code richtig verstanden habe, hat dieser die eingelesenen Daten vorrübergehend in ein Tabellenblatt zu kopieren um sie dort zu sortieren. Wenn das nicht nötig ist, um so besser.

Dein Code funktioniert schon mal sehr gut, damit komme ich schon mal weiter. Jetzt ist es nur so, dass das Enddatum auch ein anderes sein kann. Auf die Beispieltabelle bezogen z.B. das Datum ‚4‘. In der Auswertung sollen dann die Daten vom Beginn bis Ende geschrieben werden.

Ich habe mal versucht, Deinen Code zu erweitern, in dem ich für die Variable ‚Bis‘ auch eine ensprechende Abfrage gestartet habe. Das hat jedoch leider nur bewirkt, dass das Tabellenblatt „Auswertung“ gelöscht wird …???

Zum Einlesen bzw. Ausgeben hatte ich auch noch folgenden Code gefunden, habe es jedoch auch hier nicht geschafft, die Datentabelle nach Startdatum und Enddatum zu durchsuchen um den Bereich festzulegen. Das ganze soll ja dynamisch sein, da die Auswertung für die Daten eines Monats oder auch zwei, vielleicht auch für ein halben Jahres ausgezählt werden soll.

Gruß Axel

Sub transponieren()
’ Klaus-Dieter Oppermann Januar 2004
’ Variablen deklarieren
Dim arr(50000, 11) ’ Felder für Array
Dim sp As Integer ’ Zähler für Array-Felder
Dim s As Integer ’ Schleifenzähler für Zeilen
Dim ze As Long ’ Zähler für Array-Felder
ze = 1 ’ Startwert setzen
sp = 1 ’ Startwert setzen
’ Werte in Array einlesen
For s = 1 To Range(„A65536“).End(xlUp).Row ’ Schleife zum Einlesen der Werte
arr(ze, sp) = Cells(s, 1) ’ Wert in Array
sp = sp + 1 ’ Zähler plus 1
If sp = 11 Then ’ wenn 8. Zeile erreicht dann …
ze = ze + 1 ’ … Zähler plus 1
sp = 1 ’ … Zähler zurücksetzen
End If ’ Ende Bedingung
Next s ’ Schleifenzähler plus 1
’ Werte in Tabelle schreiben
Range(„B2:J500“) = arr ’ Array in Range (Bereich) übertragen
End Sub

#4

Hallo Reinhard,

habe jetzt noch mal ein bisschen probiert und mich mal genauer mit der „Match“ Funktion beschäftigt. Ich glaube das war genau das was mir gefehlt hat. Danke. Hab nun auch verstanden, warum bei den ersten Versuchen das Tabellenblatt „Auswertung“ verschwunden ist.

Mit der Match-Funktion bin ich nun auf folgenden Code gekommen. Ich suche einfach nach der Zeile unterhalb des „Bis“ Datums und ziehe am Ende einfach wieder ein Zeile ab.
Den Teil mit dem Tabellenblatt einfügen habe ich mal weggelassen.

Ich denke nun komme ich erst mal wieder ein ganzes Stück weiter.
Vielen Dank für die Hilfe.

Gruß Axel

Sub tt()

Dim Eingabe1, Eingabe2, Von, Bis, ws, wsA
Eingabe1 = InputBox(„Datum von“)
Eingabe2 = InputBox(„Datum bis“)
Eingabe2 = Eingabe2 + 1
If Eingabe1 = „“ Then Exit Sub
If Eingabe2 = „“ Then Exit Sub
Set wsA = Worksheets(„Auswertung“)
wsA.Cells.Clear
With Worksheets(„Tabelle1“)
.Activate
Von = Application.WorksheetFunction.Match(CInt(Eingabe1), .Range(„A1:A1000“), 0)
Bis = Application.WorksheetFunction.Match(CInt(Eingabe2), .Range(„A1:A1000“), 0)
.Range(Cells(Von, 1), Cells(Bis - 1, 93)).Copy Destination:=wsA.Range(„A1“)
End With
End Sub

#5

Hallo noch mal,

ich habe nun versucht den Code mit einem Datum als Suchkriterium die Spalte A zu durchsuchen.
Die Eingabe der von/bis Daten geschieht über Textboxen.
Beim Durchlaufen des Programms kommt nun jedoch ein Laufzeitfehler in der Zeile

Von = Application.WorksheetFunction.Match(Eingabe1, .Range(„A4:A1000“), 0)

Laufzeitfehler ‚1004‘. Die Match-Eigenschaft des WorksheetFunction-Objekts kann nicht zugeordnet werden

Ich vermute in der Zeile Bis = … wird es dann genau so sein.

Die Testwerte die ich eingegeben habe waren auf jeden Fall in der Spalte enthalten, es kann also nicht daran liegen das die Werte nicht gefunden werden.

Wie kommt es zu dem Fehler und wie behebe ich das Problem? Habe schon versucht die Variablenkonvertierung CDate mit in die Matchfunktion zu nehmen, hat aber auch nicht geklappt.
Im Original wurde das Suchkriterium mit CInt konvertiert, wenn ich das drin stehen lasse, bekomme ich jedoch den Fehler Überlauf. CDbl klappt auch nicht.

Ich vemute das es an der Variablen Eingabe1 bzw. Eingabe2 liegt, komme jedoch schon wieder nicht mehr weiter.

Danke, Gruß Axel

Sub cmdStartAnalysis_Click()

Dim Von, Bis, ws, wsA
Dim Eingabe1, Eingabe2 As Date

Eingabe1 = CDate(txtDateFrom.Value)
Eingabe2 = CDate(txtDateTo.Value)

Eingabe2 = Eingabe2 + 1

If Eingabe1 = „“ Then Exit Sub
If Eingabe2 = „“ Then Exit Sub

Set wsA = Worksheets(„Auswertung2“)
wsA.Cells.Clear

With Worksheets(„Eingaben“)
.Activate
Von = Application.WorksheetFunction.Match(Eingabe1, .Range(„A4:A1000“), 0)
Bis = Application.WorksheetFunction.Match(Eingabe2, .Range(„A4:A1000“), 0)
.Range(Cells(Von, 1), Cells(Bis - 1, 93)).Copy Destination:=wsA.Range(„A1“)
End With
End Sub

#6

Hallo,

Von = Application.WorksheetFunction.Match(Eingabe1,
.Range(„A4:A1000“), 0)

Laufzeitfehler ‚1004‘. Die Match-Eigenschaft des
WorksheetFunction-Objekts kann nicht zugeordnet werden

Dim Von, Bis, ws, wsA
Dim Eingabe1, Eingabe2 As Date

Du dimensionierst hier Von, Bis, ws, wsA und Eingabe1 als Variant! ‚As Date‘ bezieht sich nur auf ‚Eingabe2‘.

Wenn Du Eingabe1 auch als Datum deklarieren möchtest, mußt Du schreiben:

Dim Eingabe1 As Date, Eingabe2 As Date

Gruß, Rainer

#7

Hallo Rainer,

mit der Deklaration beider Variablen als Date besteht weiterhin ein Laufzeitfehler.

Ich habe nun folgende Lösung gefunden.
Das Datum für „von“ und „bis“ konvertiere ich mit CLng als Zahl und nutze das dann als Suchkriterium. Habe den Tipp auf einer Englisch sprachigen Seite gefunden, ist aber vermutlich auch wieder nur eine von vielen Lösungsmöglichkeiten

Danke und Gruß, Axel

Sub cmdStartAnalysis_Click()

Dim Von, Bis, wsA
Dim Eingabe1 As Long, Eingabe2 As Long

Eingabe1 = CLng(CDate(txtDateFrom.Value))
Eingabe2 = CLng(CDate(txtDateTo.Value))

Set wsA = Worksheets(„Auswertung2“)
wsA.Cells.Clear

With Worksheets(„Eingaben“)
.Activate
Von = Application.WorksheetFunction.Match(Eingabe1, .Range(„A:A“), 0)
Bis = Application.WorksheetFunction.Match(Eingabe2 + 1, .Range(„A:A“), 0)
.Range(Cells(Von, 1), Cells(Bis - 1, 93)).Copy Destination:=wsA.Range(„A1“)
End With

End Sub

#8

Hallo,

mit der Deklaration beider Variablen als Date besteht
weiterhin ein Laufzeitfehler.

ich hatte schon befürchtet, daß das mit Deinem Problem nichts zu tun hat, wird aber helfen spätere Fehler zu vermeiden.

Ich habe nun folgende Lösung gefunden.
Das Datum für „von“ und „bis“ konvertiere ich mit CLng als
Zahl und nutze das dann als Suchkriterium.

Wunderbar, wenn es funktioniert. Von VBA habe ich eben keine Ahnung. :smile:

Ein Beispiel (in VB6) noch, wo Du mit der falschen Deklaration einen Fehler bekommen würdest, den Du dann lang suchst …

Option Explicit

Private Sub Command1\_Click()
 Dim txt1 As String, txt2 As String
 Dim pfd As String
 pfd = App.Path
 If Right(pfd, 1) "\" Then
 pfd = pfd + "\"
 End If
 Open pfd + "Test.txt" For Output As #1
 Print #1, 2
 Print #1, "Test"
 Print #1, 3
 Close #1
 Open pfd + "Test.txt" For Input As #1
 While Not EOF(1)
 Input #1, txt1
 txt2 = txt2 + txt1
 Wend
 Close #1
 Me.Caption = txt2
End Sub

Das läuft …

Option Explicit

Private Sub Command1\_Click()
 Dim txt1, txt2 As String
 Dim pfd As String
 pfd = App.Path
 If Right(pfd, 1) "\" Then
 pfd = pfd + "\"
 End If
 Open pfd + "Test.txt" For Output As #1
 Print #1, 2
 Print #1, "Test"
 Print #1, 3
 Close #1
 Open pfd + "Test.txt" For Input As #1
 While Not EOF(1)
 Input #1, txt1
 txt2 = txt2 + txt1
 Wend
 Close #1
 Me.Caption = txt2
End Sub

Aber das nicht! :smile:

Gruß, Rainer

#9

ich habe nun versucht den Code mit einem Datum als
Suchkriterium die Spalte A zu durchsuchen.
Die Eingabe der von/bis Daten geschieht über Textboxen.
Beim Durchlaufen des Programms kommt nun jedoch ein
Laufzeitfehler in der Zeile

Von = Application.WorksheetFunction.Match(Eingabe1,
.Range(„A4:A1000“), 0)

Hi Axel,

find, match, vlookup usw. sind immer sehr kritisch wenn sie nichts finden und machten mir deshalb schon viele Sorgen :frowning:

Ich habe mir deshalb angewöhnt, erst mit application.worksheetfunction.countif() zu überprüfen ob es den Suchbegriff überhaupt gibt, erst dann lasse ich ich vlookup, match los.

Gruß
Reinhard

#10

Hallo Reinhard,

daran habe ich auch schon gedacht, erst einmal zu überprüfen ob es den gesuchten Wert gibt. Genauso wie die Überprüfung, ob die eingegeben Daten im gültigen Bereich sind.
Danke für den Tipp mit dem CountIf, werde ich mir mal genauer anschauen.

Gruß Axel