Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1328to1332
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
Inhaltsverzeichnis

index-vergleich

index-vergleich
15.09.2013 12:29:26
Markus
hallo,
ich habe eine äusserst verschachtelte index-vergleich Formel die auch funktioniert.
Nur ist die aktualiserung der daten sehr langsam.
ich suche nun nach einer VBA-Lösung. Vielleicht kann mir jemand behilflich sein.
Die Suchbegriffe in E9, E11 und E12 werden in der gesamten Matrix (A1:K7) (quelldatei Abfrage.xls) gesucht, B14 bis B23 (in der Zieldatei) (Formel habe ich nach unten kopiert) wird in der ersten Zeile A1:K1 der Quelldatei gesucht.
(Formel aus B14)
=INDEX('C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!$A$1:$K$7;VERGLEICH($E$9&$E$11&$E$12; 'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!$B$1:$B$7&'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!$C$1:$C$7&'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!$D$1:$D$7; 0);VERGLEICH(B14;'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!$A$1:$K$1;0))
Für Tipps bin ich dankbar
Grüße

24
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: index-vergleich
15.09.2013 20:34:23
{Boris}
Hi Markus,
ich habe eine äusserst verschachtelte index-vergleich Formel
So äußerst verschachtelt ist die doch gar nicht - eben nur ein INDEX(Bereich;VERGLEICH(...);VEGLEICH(...)) - allerdings durch die Matrixverkettung eben eine Arrayformel.
Vielleicht hilft es bereits, wenn Du die Matrix in einer separaten Spalte verkettest
='C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!B1&'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!C1&'C:\Users\Markus\Desktop\[Abfrage.xls]Tabelle1'!D1
und noch 6 mal runterkopieren.
Dann den VERGLEICH auf diese separate Hilfsspalte anwendest. Dann ist`s keine Arrayformel mehr und möglicherweise auch schneller.
Ist aber ungetestet.
VG, Boris

Anzeige
AW: index-vergleich
15.09.2013 23:11:59
Markus
Hallo Boris,
vielen dank erstmal. ich werde es versuchen.
Kann die Arrayformel überhaupt über VBA gelöst werden?
Grüße

So, wie nachfolgend aufgelöst, schon, ...
16.09.2013 02:53:08
Luc:-?
…Markus;
ansonsten könntest du es ja mal mit der vbFkt/Methode Evaluate versuchen, wobei die Fml aber unbedingt in US-OriginalNotation als Text angegeben wdn muss, also ungefähr so:
Evaluate("INDEX(Q!A1:K7,MATCH(Z!E9&E11&E12,Q!B1:B7&C1:C7&D1:D7,0),MATCH(Z!B14:B23,Q!A1:K1,0))")
Für Q! (und ggf Z!) die Dateipfade/-namen+TabNamen einsetzen (bzw das weglassen)!
Fürchte nur, dass die Fml etwas zu komplex sein könnte. Außerdem ist nicht ganz klar, wo die Fml wirklich steht. Doch nicht in B14ff, denn da sollte eigentlich der SpaltenVglswert stehen → davon bin ich auch im Folgenden ausgegangen!
Pgm setzt in dieser Form die geöffnete QuellDatei voraus:

Sub …()
Const adQrelBer$ = "A1:K7", adQvglZlBer$ = "B1:D7", adZvglZlBer$ = "E9,E11:E12", _
adQvglSpBer$ = "A1:K1", adZvglSpBer$ = "B14:B23", _
naQMap$ = "Abfrage.xls", naQTab$ = "Tabelle1"
Dim six As Long, zix As Long, _
avQrelBer, avQvglSpBer, avQvglZlBer, avZvglSpBer, avZvglZlBer, xEl As Variant, _
QrelBer As Range, QvglSpBer As Range, ZvglSpBer As Range, _
QvglZlBer As Range, ZvglZlBer As Range, xRo As Range
On Error GoTo fx
With Workbooks(naQMap).Sheets(naQTab)
Set QrelBer = .Range(adQrelBer)
Set QvglSpBer = .Range(adQvglSpBer): Set QvglZlBer = .Range(adQvglZlBer))
End With
Set ZvglSpBer = Range(adQvglSpWrt): Set ZvglZlBer = Range(adQvglZlWrt
Redim avQvglZlBer(QvglZlBer.Rows.Count - 1)
With WorksheetFunction
avQrelBer = .Transpose(.Transpose(QrelBer))
avQvglSpBer = .Transpose(.Transpose(QvglSpBer))
avZvglSpBer = .Transpose(.Transpose(ZvglSpBer))
For Each xRo In QvglZlBer.Rows
avQvglZlBer(zix) = Join(.Transpose(.Transpose(xRo)), ""): zix = zix + 1
Next xRo
With ZvglZlBer
avZvglZlBer = .Areas(1).Cells(1)
With .Areas(2)
avZvglZlBer = avZvglZlBer & .Cells(1) & .Cells(2)
End With
End With
On Error Resume Next
zix = 0: zix = .Match(avZvglZlBer, avQvglZlBer, 0)
On Error GoTo fx
If zix = 0 Then Err.Raise xlErrNA
On Error Resume Next
For Each xEl In avZvglSpBer
six = .Match(xEl, avQvglSpBer, 0)
If CBool(six) Then Exit For
Next xEl
End With
On Error GoTo fx
If IsEmpty(xEl) Then Err.Raise xlErrNA
Debug.Print avQrelBer(zix, six): Goto ex
fx: If Err.Number = xlErrNA Then
Debug.Print "Wert(" & zix & "," & six & ") nicht vorhanden!"
Else: Debug.Print Err.Description
End If
ex: Set QrelBer = Nothing: Set QvglSpBer = Nothing: Set ZvglSpBer = Nothing
Set QvglZlBer = Nothing: Set ZvglZlBer = Nothing
End Sub
Bitte alle Bereichs- und VariantNamen überprüfen (falls ich etwas vertauscht haben sollte)! Hoffe, dass diese Direktpgmmrg aus dem Stegreif fktioniert! Bessere Performance als mit der Fml kann ich aber nicht garantieren, obwohl die vorliegende Vorgehensweise wahrscheinlich schon ziemlich optimal sein dürfte.
Viel Glück! Gruß Luc :-?

Anzeige
AW: So, wie nachfolgend aufgelöst, schon, ...
16.09.2013 07:06:53
Markus
Hallo Luc,
vielen Dank für deine Hilfe.
Die Formel steht natürlich in D14, sorry.
in den zeilen habe ich noch die Punkte und Klammern korrigiert, ist das richtig so?
    Set QvglSpBer = .Range(adQvglSpBer): Set QvglZlBer = .Range(adQvglZlBer)
End With
Set ZvglSpBer = .Range(adQvglSpWrt): Set ZvglZlBer = .Range(adQvglZlWrt)
dann bekomme ich noch bei

Set ZvglSpBer = .Range(adQvglSpWrt): Set ZvglZlBer = .Range(adQvglZlWrt)
einen ungültigen Verweis.
Grüße Markus

Anzeige
AW: So, wie nachfolgend aufgelöst, schon, ...
16.09.2013 07:10:15
Hajo_Zi
Hallo Markus,
das ist klar da End With davor würde ich vermuten.

AW: So, wie nachfolgend aufgelöst, schon, ...
16.09.2013 14:37:05
Markus
Hallo,
trotzdem sind doch die Variablen oder Konstanten (adQvglSpWrt und adQvglZlWrt) nicht definiert, oder?
Ich bin in VBA nicht fit.
Grüße

AW: So, wie nachfolgend aufgelöst, schon, ...
16.09.2013 17:42:35
Hajo_Zi
da hast Du Recht in Deinem geposteten Code sind die nicht definiert.
Ich schreibe meine Beiträge immer auf den letzten Beitrag.
Gruß Hajo

Anzeige
Deshalb hatte ich geschrieben, ...
16.09.2013 18:15:13
Luc:-?
…dass du die Namen überprüfen sollst, Markus,
denn ich hatte schon befürchtet, ohne VBE-Unterstützung etwas bei der nachträglichen Namenskorrektur übersehen zu haben. Richtig wäre hier …
Set ZvglSpBer = Range(adZvglSpBer): Set ZvglZlBer = Range(adZvglZlBer
Die Punkte wären nicht richtig, weil es sich dabei ja um Ranges der ZielTabelle handelt. Allerdings müsste auch sichergestellt sein, dass die ZielTabelle auch das aktive Blatt ist.
Da du nun auch den realen Ziel-Range mitgeteilt hast, könnte auch gleich in denselben geschrieben wdn. Da anzunehmen ist, dass D14 mit B14 korrespondiert, wären folgende Änderungen/Ergänzungen erforderlich:
1. Bei Const adZrelBer$ = "D14:D23" ergänzen!
2. Bei Dim ix As Long, avZrelBer (Variant) und ZrelBer As Range ergänzen!
3. Nach bzw unmittelbar vor der o.g. korrigierten PgmZeile Set ZrelBer = .Range(adZrelBer) einfügen!
4. On Error Resume Next und anschld For Each xEl In avZvglSpBer … Next xEl und die 4 nflgd Zeilen durch Folgendes ersetzen:
        Redim avZrelBer(UBound(avZvglSpBer))
For Each xEl In avZvglSpBer
On Error Resume Next
six = .Match(xEl, avQvglSpBer, 0)
On Error GoTo fx
If CBool(six) Then
avZrelBer(ix) = avQrelBer(zix, six)
Else: avZrelBer(ix) = CVErr(xlErrNA)
End If
ix = ix + 1
Next xEl
ZrelBer = .Transpose(avZrelBer)
End With
GoTo ex
5. Die FehlerBehdl ab Marke fx: kann auch als MsgBox-Ausgabe gestaltet wdn. Statt Debug.Print also MsgBox!
6. Die Endbehdl ab Marke ex: ist durch : Set ZrelBer = Nothing zu ergänzen!
Noch ein Tipp: In den VBE-Einstellungen Variablendeklaration erforderlich anhaken! Dadurch wird beim nächsten Mal Option Explicit am Anfang eines jeden Moduls eingefügt. Hier musst du das aber wohl noch manuell tun.
Gruß Luc :-?

Anzeige
AW: Deshalb hatte ich geschrieben, ...
16.09.2013 20:38:00
Markus
Hallo Luc,
super! vielen, vielen Dank für Deine Mühe und Hilfe. Ich komme weiter und lerne noch so einiges dabei.
Aber ein kleines Problem habe ich noch.
bei den Suchkriterien ("E9,E11:E12") ist ein Datum dabei, das wird im QBereich nicht gefunden bzw. ignoriert.
Kannst Du mir da bitte nochmal helfen?
Grüße
Ich habe jetzt folgenden code.

Option Explicit
Private Sub CommandButton1_Click()
Const adQrelBer$ = "A1:K7"
Const adQvglZlBer$ = "B1:D7"
Const adZvglZlBer$ = "E9,E11:E12"
Const adQvglSpBer$ = "A1:K1"
Const adZvglSpBer$ = "B14:B23"
Const naQMap$ = "Abfrage.xls"
Const naQTab$ = "Tabelle1"
Const adZrelBer$ = "E14:E23"
Dim six As Long
Dim zix As Long
Dim avQrelBer As Variant
Dim avQvglSpBer As Variant
Dim avQvglZlBer As Variant
Dim avZvglSpBer As Variant
Dim avZvglZlBer As Variant
Dim xEl As Variant
Dim QrelBer As Range
Dim QvglSpBer As Range
Dim ZvglSpBer As Range
Dim QvglZlBer As Range
Dim ZvglZlBer As Range
Dim xRo As Range
Dim ix As Long
Dim avZrelBer As Variant
Dim ZrelBer As Range
On Error GoTo fx
With Workbooks(naQMap).Sheets(naQTab)
Set QrelBer = .Range(adQrelBer)
Set QvglSpBer = .Range(adQvglSpBer): Set QvglZlBer = .Range(adQvglZlBer)
End With
Set ZrelBer = Range(adZrelBer)
Set ZvglSpBer = Range(adZvglSpBer): Set ZvglZlBer = Range(adZvglZlBer)
ReDim avQvglZlBer(QvglZlBer.Rows.Count - 1)
With WorksheetFunction
avQrelBer = .Transpose(.Transpose(QrelBer))
avQvglSpBer = .Transpose(.Transpose(QvglSpBer))
avZvglSpBer = .Transpose(.Transpose(ZvglSpBer))
For Each xRo In QvglZlBer.Rows
avQvglZlBer(zix) = Join(.Transpose(.Transpose(xRo)), ""): zix = zix + 1
Next xRo
With ZvglZlBer
avZvglZlBer = .Areas(1).Cells(1)
With .Areas(2)
avZvglZlBer = avZvglZlBer & .Cells(1) & .Cells(2)
End With
End With
On Error Resume Next
zix = 0: zix = .Match(avZvglZlBer, avQvglZlBer, 0)
On Error GoTo fx
If zix = 0 Then Err.Raise xlErrNA
On Error Resume Next
ReDim avZrelBer(UBound(avZvglSpBer))
For Each xEl In avZvglSpBer
On Error Resume Next
six = .Match(xEl, avQvglSpBer, 0)
On Error GoTo fx
If CBool(six) Then
avZrelBer(ix) = avQrelBer(zix, six)
Else: avZrelBer(ix) = CVErr(xlErrNA)
End If
ix = ix + 1
Next xEl
ZrelBer = .Transpose(avZrelBer)
GoTo ex
End With
On Error GoTo fx
If IsEmpty(xEl) Then Err.Raise xlErrNA
Debug.Print avQrelBer(zix, six): GoTo ex
fx:     If Err.Number = xlErrNA Then
Debug.Print "Wert(" & zix & "," & six & ") nicht vorhanden!"
Else: Debug.Print Err.Description
End If
ex:     Set QrelBer = Nothing: Set QvglSpBer = Nothing: Set ZvglSpBer = Nothing
Set QvglZlBer = Nothing: Set ZvglZlBer = Nothing: Set ZrelBer = Nothing
End Sub

Anzeige
'End With' steht bei mir vor 'GoTo ex', ...
16.09.2013 21:38:23
Luc:-?
…Markus,
und die 3 Folgezeilen können jetzt entfallen (hatte ich erwähnt!).
Zum Datumsproblem:
Das sollte keine Probleme bereiten, wenn das zu findende Datum sowohl in der in den Suchbegriff als auch in der in den Suchbereich eingehenden Zelle auf gleiche Weise formatiert wurde, also entweder eine Ganzzahl oder ein Datumstext ist. Wenn das nicht der Fall ist, sollte das Datum im Suchbegriffsbereich bei Zusammenstellung des Suchbegriffs entsprd umformatiert wdn. Ist es eine Zahl, sollte an .Cells(…) .Text angehängt wdn. Anderenfalls ist es in eine solche umzuwandeln mit CDate(.Cells(…)). Das ist an dieser Stelle einfacher als es im Suchbereich zu tun.
Gruß Luc :-?

Anzeige
AW: 'End With' steht bei mir vor 'GoTo ex', ...
16.09.2013 22:23:25
Markus
hallo Luc,
danke, dass Du so eine Geduld mit mir hast.
Das mit den 3 Folgezeilen nach GotoEx habe ich überlesen.
ich habe jetzt
        On Error GoTo fx
If IsEmpty(xEl) Then Err.Raise xlErrNA
Debug.Print avQrelBer(zix, six): GoTo ex
gelöscht.
Und EndWith steht bei mir jetzt auch vor GotoEx :-)
Zum Datumsproblem:
In der Quell- und Zieldatei sind die Zellen mit Datum formatiert, jedoch nicht als Datumstext.
Kannst Du mir dann genau sagen, wo und wie ich den Suchbegriff umformatieren muss. Das Datum wird über die Zelle E11 (z.B. 16.09.2013) gesucht.
Danke
Grüße Markus

Anzeige
Wenn das Datum in beiden Dateien als Datum - ...
17.09.2013 17:46:24
Luc:-?
…also als Zahl – steht, Markus,
sollte es eigentlich ohne Konvertierungen fktionieren. Allerdings könnte es sein, dass das Datum nicht als Ganzzahl in den fraglichen Zellen steht, sondern als Dezimalzahl, weil noch eine Uhrzeit mit eingeflossen ist, zB, falls (ursprgl) die Fkt JETZT() anstelle der Fkt HEUTE() zur Erzeugung des Datums benutzt (und dann ggf damit weitergearbeitet) wurde. Das solltest du erst mal überprüfen und dann ggf in Quell- und ZielDatei korrigieren. Das wäre dann am Einfachsten.
Noch ein Tipp: Es hängt zwar primär von deiner Datenlage ab, ob eine Zellinhaltsverknüpfung mit &-Operator ohne Zwischeneinschübe ausreichend ist, aber besser ist es idR solche vorzusehen und sie auch an Anfang und Ende der jeweiligen Begriffe zu setzen, um zufällige TextÜberlappungen zu vermeiden. Bsp: Q-SuchbereichsVerknüpfung ⇒ "|Meier|diebisch|", Suchbegriff ⇒ "|eierdieb|"
Der Suchbegriff wird so nicht gefunden, was hier ja auch richtig wäre. Bei einer Verknüpfung ohne "|"° würde er aber gefunden wdn → "Meierdiebisch", was hier ja eigentl nicht richtig wäre! Aber das musst und kannst nur du anhand deiner Datenlage entscheiden.
° Anstelle von "|" kann natürlich auch jedes andere, nicht in den Texten enthaltene Zeichen benutzt wdn, auch unter Zuhilfenahme der vbFkt Chr(zahl) inkl Chr(0)!
Gruß Luc :-?

Anzeige
Was soll flgd Befelsgruppe, ...
18.09.2013 05:08:17
Luc:-?
…Markus?
Application.ScreenUpdating = False
Set wb = GetObject(ThisWorkbook.Path & "\Abfrage.xls")
Application.ScreenUpdating = True

Willst du mit einer geschlossenen QuellMappe arbeiten? Das wird wohl so nix wdn! Außerdem hatte ich für den QuellDateiNamen eine Konstante gesetzt, die du hierbei nicht benutzt hast!
Das Datum in E11 wird vglbar, wenn du an entsprd Stelle CLng(.Cells(1)) schreibst!
Morrn, Luc :-?

AW: Was soll flgd Befelsgruppe, ...
18.09.2013 22:48:19
Markus
Hallo Luc :-?,
über GetObject kann ich doch die Datei öffnen und das funktioniert auch (meine datei heißt ja abfrage.xls - nur durch's hochladen wurde der dateinamen verändert). Die Konstante hol' ich noch nach, versprochen.
ich habe diesen Bereich geändert und das funktioniert jetzt auch. Vielen Dank dafür.
             With .Areas(2)
avZvglZlBer = avZvglZlBer & CLng(.Cells(1)) & .Cells(2)
End With
Luc :-?, falls du mir noch eine bessere Lösung als die GetObject für die Quelldatei hast, dann lern ich gerne weiter...
Grüße

Nee, aber es gab Probleme auch nach ...
18.09.2013 23:22:49
Luc:-?
…Umbenennung, weil die Datei nicht gefunden wurde und deshalb class verlangt wurde, Markus.
Flackert der Bildschirm bei dir, wenn so die andere Mappe verdeckt im HG geladen wird, weil du ScreenUpdating aus-/eingeschaltet hast? Ansonsten gäbe es nur noch direktes Öffnen der anderen Datei oder Lesen aus „geschlossener“° per ExecuteExcel4Macro.
° Wird wohl auch kurzzeitig verdeckt geöffnet, also wurscht!
Konstanten sind in 1.Linie dazu da, den Änderungsaufwand (besonders wichtig bei größeren Projekten!) und (ggf daraus resultierend) die FehlerAnfälligkeit des Pgms zu minimieren.
Na dann, viel Erfolg! Gruß Luc :-?

AW: Nee, aber es gab Probleme auch nach ...
18.09.2013 23:34:37
Markus
hallo Luc :-?,
das screenupdating aus/ein habe ich raus genommen (da es nichst bringt) und die Konstante gesetzt.
Du hast mir wirklich sehr geholfen und echt weiter gebracht.
Kleinigkeiten habe ich noch:
- probleme bei leerzeilen in der adZvglSpBer, leerzeilen werden "ignoriert und der "vorzellwert" übernommen.
- wenn ich die Suchfelder (adZvglZlBer) ändere, z.B. von Const adZvglZlBer$ = "E9,E11,E12" in Const adZvglZlBer$ = "E9,F11,E12" wird nichts mehr gefunden, aber das sind wirklich Kleinigkeiten, die ich momentan natürlich anders lösen kann.
Grüße Markus

Auf das 2.Problem kann ich gleich antw'n, ...
19.09.2013 03:26:54
Luc:-?
…Markus;
wenn du die Konstante adZvglZlBer$ auf "E9,F11,E12" änderst, hast du damit 3 Areas statt nur 2 und musst jedesmal .Cells(1) ansprechen.
Bei Leerzeilen muss ich noch mal nachsehen.
…Und ist das nun schneller als die Formel…?
Morrn, Luc :-?

AW: Auf das 2.Problem kann ich gleich antw'n, ...
19.09.2013 18:15:15
Markus
Hallo Luc,
das kann ja dann nur der Bereich sein: Aber leider bekomme ich es nicht hin :(
With ZvglZlBer
avZvglZlBer = .Areas(1).Cells(1)
With .Areas(2)
avZvglZlBer = avZvglZlBer & CLng(.Cells(1)) & .Cells(2)
End With
End With
Grüße

Na, dann machen wir's mal besser ganz ...
20.09.2013 02:33:00
Luc:-?
…anders, Markus,
damit nicht bei jeder Änderung der fraglichen Zellen auch noch ins Pgm eingegriffen wdn muss:
adZvglZlBer$ ist jetzt = "E9,F11,E12". Wir nehmen nun die angegebenen Zellen einzeln. Dadurch entfallen Set ZvglZlBer = Range(adZvglZlBer) und Set ZvglZlBer = Nothing; ZvglZlBer As Range wird zu ZvglZlBer As String. Hinzu kommt Dim azZvglZlBer (As Variant). Der PgmTeil von With ZvglZlBer bis einschl des zugehörigen End With ist dann durch Folgendes zu ersetzen:
azZvglZlBer = Split(adZvglZlBer, ",")
avZvglZlBer = Array(Range(azZvglZlBer(1)), Range(azZvglZlBer(2)), Range(azZvglZlBer(3)))

Bleibt noch das Problem der Leerzellen:
Es ist natürlich klar, dass ein aus 3 Werten zusammengesetzter Suchbegriff wie avZvglZlBer in einem SuchVektor wie avQvglZlBer, dessen Elemente aus weniger als 3 Werten zusammengesetzt wurden, was bei auftretenden Leerzellen quasi der Fall wäre, nicht gefunden wdn kann. Das gleiche gilt natürlich auch umgekehrt, während es im Falle von avQvglSpBer keine derartigen Probleme geben dürfte. Wenn nun stets der erste (alle wäre etwas komplizierter!) Suchbegriffstreffer gefunden wdn soll, auch, wenn Teile des Suchbegriffs nicht vorhanden sind, muss anders vorgegangen wdn, bspw so (hierfür noch Dim nix As Integer hinzufügen!):
zix = 0: nix = UBound(avZvglZlBer) + 1
Do: ZvglZlBer = Join(avZvglZlBer, "")
If CBool(ix) Then
If ix > nix
If ix = 2 * nix Then
ZvglZlBer = Replace(Replace(ZvglZlBer, avZvglZlBer(0), _
"", 1, 1), avZvglZlBer(nix - 1), "", 1, 1)
Else: ZvglZlBer = Replace(Replace(ZvglZlBer, avZvglZlBer(ix - nix _
- 1), "", 1, 1), avZvglZlBer(ix - nix), "", 1, 1)
End If
Else: ZvglZlBer = Replace(ZvglZlBer, avZvglZlBer(ix - 1), "", 1, 1)
End If
End If
zix = .Match(ZvglZlBer, avQvglZlBer, 0)
If CBool(zix) Then Exit Do Else ix = ix + 1
Loop Until ix > 2 * nix
ix = 0
Das fktioniert aber nur richtig, wenn nie mehr als 3 Werte im Vektor avZvglZlBer enthalten sein wdn! Auch sollten keine Leerzellen in den Suchbegriff ZvglZlBer (aus avZvglZlBer) eingehen!
Auf If zix = 0 Then Err.Raise xlErrNA kann verzichtet wdn, wenn im nächsten For Each-Zyklus If CBool(six) Then durch And CBool(zix) ergänzt wird. Damit könnte dann auch die FehlerBehdl kürzer gefasst wdn:
fx: Debug.Print Err.Description oder …
fx: MsgBox Err.Description, vbCritical, "Interner Fehler"
Gruß Luc :-?
Besser informiert mit …

AW: Na, dann machen wir's mal besser ganz ...
21.09.2013 18:38:38
Markus
Hallo Luc :-?
das mit den leerzellen pack ich mal noch nicht an... aber danke für deine Lösung.
Aber mit den anderen Änderungen komm ich nicht zurecht. Wahrscheinlich habe ich etwas übersehen oder falsch gemacht. Es funktioniert so nicht.
ich poste mal den kompletten code:
Option Explicit
Private Sub aktualisieren()
Const adQrelBer$ = "A1:K7"
Const adQvglZlBer$ = "B1:D7"
Const adZvglZlBer$ = "E9,F11,E12"
Const adQvglSpBer$ = "A1:K1"
Const adZvglSpBer$ = "B14:B23"
Const naQMap$ = "Abfrage.xls"
Const naQTab$ = "Tabelle1"
Const adZrelBer$ = "E14:E23"
Dim six As Long
Dim zix As Long
Dim avQrelBer As Variant
Dim avQvglSpBer As Variant
Dim avQvglZlBer As Variant
Dim avZvglSpBer As Variant
Dim avZvglZlBer As Variant
Dim xEl As Variant
Dim QrelBer As Range
Dim QvglSpBer As Range
Dim ZvglSpBer As Range
Dim QvglZlBer As Range
Dim ZvglZlBer As String
Dim xRo As Range
Dim ix As Long
Dim avZrelBer As Variant
Dim ZrelBer As Range
Dim azZvglZlBer As Variant
On Error GoTo fx
With Workbooks(naQMap).Sheets(naQTab)
Set QrelBer = .Range(adQrelBer)
Set QvglSpBer = .Range(adQvglSpBer): Set QvglZlBer = .Range(adQvglZlBer)
End With
Set ZrelBer = Range(adZrelBer)
Set ZvglSpBer = Range(adZvglSpBer)
ReDim avQvglZlBer(QvglZlBer.Rows.Count - 1)
With WorksheetFunction
avQrelBer = .Transpose(.Transpose(QrelBer))
avQvglSpBer = .Transpose(.Transpose(QvglSpBer))
avZvglSpBer = .Transpose(.Transpose(ZvglSpBer))
For Each xRo In QvglZlBer.Rows
avQvglZlBer(zix) = Join(.Transpose(.Transpose(xRo)), ""): zix = zix + 1
Next xRo
azZvglZlBer = Split(adZvglZlBer, ",")
avZvglZlBer = Array(Range(azZvglZlBer(1)), Range(azZvglZlBer(2)), Range(azZvglZlBer(3)) _
)
On Error Resume Next
zix = 0: zix = .Match(avZvglZlBer, avQvglZlBer, 0)
On Error GoTo fx
If zix = 0 Then Err.Raise xlErrNA
On Error Resume Next
ReDim avZrelBer(UBound(avZvglSpBer))
For Each xEl In avZvglSpBer
On Error Resume Next
six = .Match(xEl, avQvglSpBer, 0)
On Error GoTo fx
If CBool(six) Then
avZrelBer(ix) = avQrelBer(zix, six)
Else: avZrelBer(ix) = CVErr(xlErrNA)
End If
ix = ix + 1
Next xEl
ZrelBer = .Transpose(avZrelBer)
End With
GoTo ex
fx:     If Err.Number = xlErrNA Then
Debug.Print "Wert(" & zix & "," & six & ") nicht vorhanden!"
'Range("E14:E23").Value = Empty
Else: Debug.Print Err.Description
End If
ex:     Set QrelBer = Nothing: Set QvglSpBer = Nothing: Set ZvglSpBer = Nothing
Set QvglZlBer = Nothing: Set ZrelBer = Nothing
End Sub

Hatte Fehler bei Indizes gemacht, ...
21.09.2013 21:48:49
Luc:-?
…Markus;
avZvglZlBer = Array(Range(azZvglZlBer(0)), Range(azZvglZlBer(1)), Range(azZvglZlBer(2))) wäre richtig. Außerdem nahm ich an, du würdest die LeerzellenSache auch gleich mitändern, dann würde es mit dieser Änderung jetzt fktionieren. Ohne das, müsstest du aber trotzdem ZvglZlBer As String deklarieren und mit ZvglZlBer = Join(avZvglZlBer, "") erzeugen und beim Vgl einsetzen:
zix = .Match(ZvglZlBer, avQvglZlBer, 0)
Gruß Luc :-?

AW: Hatte Fehler bei Indizes gemacht, ...
22.09.2013 10:31:28
Markus
Guten Morgen Luc,
wo genau muss ich denn
ZvglZlBer = Join(avZvglZlBer, "")
zix = .Match(ZvglZlBer, avQvglZlBer, 0)
einsetzen? Leerzellen problem mag ich noch nicht ran... das schau ich mir dann irgendwann mal an. Muss noch viel lernen was VBA angeht.
Viele Grüße

Das ist doch nicht schwer, ...
22.09.2013 15:33:04
Luc:-?
…Markus;
zix = .Match(ZvglZlBer, avQvglZlBer, 0) für den alten zix = .Match(…)-Befehl und ZvglZlBer = Join(avZvglZlBer, "") in einer neuen Zeile unmittelbar darüber einfügen.
SchöWaSo, Luc :-?
PS: Für die nächste Frage musst du einen neuen Thread aufmachen, denn hier ist jetzt nämlich Schluss → der Thread isr nicht mehr im Forum und nur noch kurzzeitig mit Trick fortsetzbar.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige