so jetzt hab ich mal was (umständliches) in VBA programmiert, was aber noch nicht so ganz will:
Kann vielleicht jemand mal kurz drüber schauen und grobe Fehler aufzeigen?
prinzipiell ist die Aufgabenstellung folgende:
Aus einer tabelle sollen einige Werte entnommen werden (unter berücksichtgung bestimmter Kriterien).
Manche der Kriterien sind eindimensional (haben also nur 0/1 Wert) andere haben bis zu 4 Dimensionen.
nachher wird alles auf einem Tabellenblatt sortiert angezeigt (die Sortierung fehlt hier noch).
Vorgehensweise:
1) Auswahl der eindimensionalen Variablen udn Filtern der Daten -> alle potentiellen Zeilen, die ein ERgebnis enthalten können werden in einen Array gesteckt
2) Auswahl mittels 2. Stufe kriterien Basis: Array aus 1) -> Ergebnis wieder in einen Array
3) Auswahl mittels 3. Stufe (mehrdimensional) -> Überschreiben der nicht passenden zeilen im array mit 0
4) Auswahl der gewünschten Daten anhand der zeilen, die im Array stehen und dann copy & Paste auf die gewünschte seite
5) Sortierung & Copy&Paste
Das muss ich noch 'entwickeln'
Würde mich freuen wenn der/die eine oder andere noch ein paar Anmerkungen machen könnte.
Bisher bricht die ganze sache ab bei:
Function Schreiben:
Arr4(i2) = Range("E" + Arr2(i1))
mit der fehlermeldung:
Sub oder
Function nicht bekannt.
Hab ich die Arrays falsch initialisiert/deklariert?
Ach ja:
Am Code sieht man, dass ich der absolute Anfänger bin ;)
Sub CommandButton1_Click()
'Programmiert von: Jochen Walz im Februar 2008
'Das VBA-Skript soll alle Zeilen im Tabellenblatt XXX auswählen, die den Kriterien entsprechen.
'Danach werden die Ergebnisse sortiert und im Blatt Übersicht angezeigt.
'Variablen aus Tabellenblatt
Public Kriterium1 As String
Public Kriterium2 As String
Public Kriterium3 As String
Public Kriterium4 As String
Public Anbieter1 As String
Public Anbieter2 As String
Public ANBIETER3 As String
Public ANBIETER4 As String
Public Anbieter5 As String
Public ANBIETER6 As String
Public Summe1 As Integer
Public Summe2 As Integer
'Zählvariable
Public Zaehler1 As Integer
Public Zaehler2 As Integer
Public Zaehler3 As Integer
Public i As Integer
'Variablen aus ausgewählten Relationen, die im Blatt Übersicht angezeigt werden sollen
Public Zielkriterium1 As Double
Public Zielkriterium2 As String
Public Zielkriterium3 As String
Public Zielkriterium4 As String
'Variablen zur Zwischenlagerung von Tabellenwerten
Public Arr1 As Integer
Arr1 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, _
_
24, 25, 26, 27, 28, 29, 30)
Public Arr2 As Integer
Arr2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, _
_
24, 25, 26, 27, 28, 29, 30)
Public Arr3 As Integer
Arr3 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, _
_
24, 25, 26, 27, 28, 29, 30)
Call Einlesen
'Bereiche für Auswertung leeren, falls das Programm mehrmals mit untersch. Variablen aufgerufen _
_
wird
Range("P19:T43") = ""
'Schleife -> Alle Zeilen (500) im Datensatz auswerten, ob passend zu Kriterien, in den nächsten _
_
Schleifen nur Auswertung des Arrays
i = 5
Do Until i = 500
Call VergleichStufe1
i = i + 1
Loop
i = 1
Do Until i = 30
Call VergleichStufe2
i = i + 1
Loop
i = 1
Do Until i = 30
Call VergleichStufe3
i = i + 1
Loop
Call Schreiben
End Sub
Function Einlesen()
'Werte aus Tabellenblatt in Variablen einlesen
Kriterium1 = Range("P6").Value
Kriterium2 = Range("Q6").Value
Kriterium3 = Range("R6").Value
Kriterium4 = Range("S6").Value
Summe1 = Range("P12").Value
Summe2 = Range("S12").Value
Anbieter1 = Range("P11").Value
Anbieter2 = Range("Q11").Value
ANBIETER3 = Range("R11").Value
ANBIETER4 = Range("S11").Value
Anbieter5 = Range("T11").Value
ANBIETER6 = Range("U11").Value
End Function
Function VergleichStufe1()
'Vergleich der zeilen in Datentabelle mit Kriterien, falls positiv: Aufruf der Funktion _
Scheiben
'Wenn alle Kriterien Stimmen werden einzelne Variablen aus der Zeile
Dim i2 As Integer
i2 = 1
If Kriterium1 = Range("A" + i) Then
If Kriterium2 = Range("B" + i) Then
If Kriterium3 = Range("C" + i) Then
If Kriterium4 = Range("D" + i) Then
Arr1(i2) = i
i2 = i2 + 1
End If
End If
End If
Else
End If
End Function
Function VergleichStufe2()
'Vergleich der Zeilen mit dem 2. Set an Kriterien
Dim i2 As Integer
i2 = 1
Dim i3 As Integer
i3 = 1
Do
If Anbieter1 = 1 And Range("E" + Arr1(i2)) Then
Arr2(i3) = Arr1(i2)
i3 = i3 + 1
End If
If Anbieter2 = 1 And Range("E" + Arr1(i2)) Then
Arr2(i3) = Arr1(i2)
i3 = i3 + 1
End If
If ANBIETER3 = 1 And Range("E" + Arr1(i2)) Then
Arr2(i3) = Arr1(i2)
i3 = i3 + 1
End If
If Arr1(i2) = 0 Then
Exit Do
End If
End Function
Function VergleichStufe3()
Dim i5 As Integer
i5 = 1
'Vergleich der Zeilen mit weiteren Kriterien
Do Until i5 = 30
If ANBIETER4 = 0 Then
If Range("L" + Arr2(i5)) = "ANBIETER4" Or Range("T" + Arr2(i5)) = "ANBIETER4" Then
Arr2(i5) = 0
End If
End If
If ANBIETER6 = 0 Then
If Range("H" + Arr2(i5)) = "ANBIETER3" Then
Arr2(i5) = 0
End If
End If
If Anbieter5 = 0 Then
If Range("H" + Arr2(i5)) = "Anbieter5" Or Range("X" + Arr2(i5)) = "Anbieter5" Then
Arr2(i5) = 0
End If
End If
i5 = i5 + 1
Loop
End Function
Function Schreiben()
'Schreibt die Werte in das erste Tabellenblatt in nicht sichtbare Zeilen
Dim i2 As Integer
Dim i1 As Integer
Dim i3 As Integer
Dim Arr4 As Integer
Arr4 = Array(1, 2, 3, 4, 5, 6)
i1 = 1
i3 = 19
'Einlesen aus Datenblatt & Schreiben auf Übersichtsblatt
Do Until i1 = 30
i2 = 1
Arr4(i2) = Range("E" + Arr2(i1))
i2 = 2
Arr4(i2) = Range("AC" + Arr2(i1))
i2 = 3
Arr4(i2) = Range("AD" + Arr2(i1))
i2 = 4
Arr4(i2) = Range("AE" + Arr2(i1))
i2 = 5
Arr4(i2) = Range("AF" + Arr2(i1))
i2 = 6
Arr4(i2) = Range("AG" + Arr2(i1))
'Schreiben der (6) Werte
Do Until i3 = 24
Range("P" + i3) = Arr4(i1)
i3 = i3 + 1
Loop
i1 = i1 + 1
Loop
End Function
Function SortierenundPraesentation()
'Sortiert alle Ergebnisse und schreibt diese in die entsprechenden Felder für die Übersicht
'wird noch ergänzt
End Function