Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1420to1424
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
1420to1424
1420to1424
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Index Vergleich Loop

Index Vergleich Loop
22.04.2015 10:19:55
Shahed
Hallo zusammen,
Dank euch habe ich folgende Index-Vergleich Prozedur geschrieben: 

Sub InbexVorher()
Sheets("Auszug_vorher").Select
Dim rngFund As range
Dim rngNAV As range
Dim rngTYP As range
Dim j As Integer 'Zeile
Dim i As Integer 'Spalte
Dim x As Variant
Set rngFund = Sheets("Auszug_nachher").range("B:G")
Set rngNAV = Sheets("Auszug_nachher").range("B:B")
Set rngTYP = Sheets("Auszug_nachher").range("B1")  'Problem
Vergleich = Application.WorksheetFunction.Match(rngTYP, rngNAV, 0) 'Problem
x = Application.WorksheetFunction.Index(rngFund, Vergleich, 6) 'Problem
Sheets("Auszug_nachher").range("A1").Value = x     'Problem
End Sub

Problem:
Dieser INDEX VERGLEICH rechnet mir X als Ergebnis und gibt mir X in der Zelle A1 aber meine Tabelle hat 200000 Datensätze. Ich möchte gerne, dass die VBA bei jede Zeile meiner Tabelle die Berechnung wiederholt und die Ergebnisse in der Spalte A:A zurückgibt.
qwasi bei nächste rngTYP (B2 statt B1), nächste Ergebis X (A2 statt A1) usw...
hat jemand eine Idee, wie ich es hinkriegen kann?
Ich bedanke euch recht herzlich!
Beste Grüße
Shahed

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Index Vergleich Loop
22.04.2015 11:45:56
Rudi
Hallo,
ich verstehe den Sinn nicht.
Ales spielt sich auf dem selben Blatt ab.
Du suchst B1 in B:B, findest es natürlich in B1 und schreibst dann G1 nach A1 etc?
Warum nicht gleich in A1 =G1 und runter kopieren?
Gruß
Rudi

AW: Index Vergleich Loop
22.04.2015 13:30:43
Shahed
Hallo Rudi,
zunächst vielen dank von schneller Rückmeldung.
Also diese Tabellenabstimmung wird häufig verwende und die Dateien haben 200.000 Daten sätze, von daher muss automatisiert werden. Sverweis ist hier auch nicht möglich, da die Dateien unterschiedliche Bezüge und Matrixe haben. lange Rede kurze Sinn...
Also die VBA muss B1 von Sheet Auszug_vorher mit B1 von Sheet Auszug_nachher vergleichen und bei Identische Resultaten G1 von Sheet Auszug_vorher mir in der A1 liefern.
Frage: Wie kann ich definieren, dass meine VBA nach erste Zeile zweite Zeile (bis zum Ende der Tabelle) hintereinander berechnet und jeweilige Ergebnisse in der Spalte A liefert.
Kopieren ist nicht möglich, da in der Tabelle kein Formel gibt außerdem dauert es bei manuellem Kopieren und Ziehen ewig lang.
wie kann ich in der VBA eine Loop definieren, so B1 bis B100 und das Ergebnis in der Zelle A1 bis A100?
Set rngTYP = Sheets("Auszug_nachher").range("B1") 'LOOP für Range B1 von B1 bis z.B B100
Vergleich = Application.WorksheetFunction.Match(rngTYP, rngNAV, 0)
x = Application.WorksheetFunction.Index(rngFund, Vergleich, 6)
Sheets("Auszug_nachher").range("A1").Value = x 'LOOP für X von A1 bis z.B A100
Danke
Gruß
Shahed

Anzeige
AW: Index Vergleich Loop
22.04.2015 14:39:13
Rudi
Hallo,
das steht aber so nicht in deinem Code.
Set rngFund = Sheets("Auszug_nachher").range("B:G")
Set rngNAV = Sheets("Auszug_nachher").range("B:B")
Set rngTYP = Sheets("Auszug_nachher").range("B1") 'Problem
Vergleich = Application.WorksheetFunction.Match(rngTYP, rngNAV, 0) 'Problem
x = Application.WorksheetFunction.Index(rngFund, Vergleich, 6) 'Problem
Sheets("Auszug_nachher").range("A1").Value = x 'Problem
Gruß
Rudi

AW: Index Vergleich Loop
22.04.2015 15:11:12
Shahed
Herzlichen besten Dank Rubi,
Prima...allerdings werden jetzt die Ergebnisse Horinzental in der Zeile 7 gezeigt, kannst du bitte so schreiben, dass die Ergebnisse vertikal in der Spalte A dargestellt werden?
Gruß
Shahed

Anzeige
AW: Index Vergleich Loop
22.04.2015 15:19:16
Shahed
Herzlichen besten Dank Rubi,
Prima...allerdings werden jetzt die Ergebnisse Horinzental in der Zeile 7 gezeigt, kannst du bitte so schreiben, dass die Ergebnisse vertikal in der Spalte A dargestellt werden?
Gruß
Shahed

AW: Index Vergleich Loop
22.04.2015 14:47:16
Rudi
Hallo, 
Sub IndexVorher()
Dim rngFund As Range
Dim rngNAV As Range
Dim rngTYP As Range
Dim x As Variant
Dim Vergleich As Variant
Set rngFund = Sheets("Auszug_vorher").Range("B:G")
Set rngNAV = Sheets("Auszug_vorher").Range("B:B")
With Sheets("Auszug_nachher")
For Each rngTYP In .Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
Vergleich = Application.Match(rngTYP, rngNAV, 0) 'Problem
If Not IsError(Vergleich) Then
rngTYP.Offset(, -1) = rngFund.Cells(Vergleich, 6)
End If
Next rngTYP
End With
End Sub
Gruß
Rudi

Anzeige
AW: Index Vergleich Loop
22.04.2015 15:22:48
Shahed
Herzlichen besten Dank Rubi,
Prima...allerdings werden jetzt die Ergebnisse Horinzental in der Zeile 7 gezeigt, kannst du bitte so schreiben, dass die Ergebnisse vertikal in der Spalte A dargestellt werden?
Gruß
Shahed

läuft bei mir korrekt. owT
22.04.2015 16:00:31
Rudi

AW: läuft bei mir korrekt. owT
22.04.2015 16:17:09
Shahed
Sorry Stimmt, du hast vollkommend recht. Vielen Dank. wie gesagt, die Datei hat 200000 Zeile Daten, und die VBA braucht 45 minuten, kann man wegen der Preformance was machen?
Gruß
Shahed

AW: läuft bei mir korrekt. owT
22.04.2015 16:29:14
Rudi
Hallo,
hab ich übersehen.
Sollte schneller sein: 
Sub IndexVorher()
Dim rngFund As Range
Dim rngNAV As Range
Dim arrErg
Dim i As Long
Dim Vergleich As Variant
Application.ScreenUpdating = False
Set rngFund = Sheets("Auszug_vorher").Range("B:G")
Set rngNAV = Sheets("Auszug_vorher").Range("B:B")
With Sheets("Auszug_nachher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
Vergleich = Application.Match(arrErg(i, 2), rngNAV, 0)
If Not IsError(Vergleich) Then
arrErg(i, 1) = rngFund.Cells(Vergleich, 6)
End If
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
End Sub

Gruß
Rudi

Anzeige
AW: läuft bei mir korrekt. owT
23.04.2015 11:02:50
Shahed
Hallo Rudi,
vielen herzlichen Dank. ich Teste jetzt und sage Dir Bescheid.
Gruß
Shahed

AW: läuft bei mir korrekt. owT
23.04.2015 13:11:41
Shahed
Hallo Rudi,
also Der Code hat 71 Minuten gedauert. Da der Code zwei mal abgepielt wird (Auszug_vorher gegen Auszug_nachher und umgekehrt), dauert es 142 Minuten. 
Sub AuszugVorher()
Dim t As Double
t = Time
Dim rngFund As Range
Dim rngNAV As Range
Dim arrErg
Dim i As Long
Dim Vergleich As Variant
Application.ScreenUpdating = False
Set rngFund = Sheets("Auszug_vorher").Range("B:G")
Set rngNAV = Sheets("Auszug_vorher").Range("B:B")
With Sheets("Auszug_nachher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
Vergleich = Application.Match(arrErg(i, 2), rngNAV, 0)
If Not IsError(Vergleich) Then
arrErg(i, 1) = rngFund.Cells(Vergleich, 6)
End If
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
MsgBox Timer - t & " sec", , "Makrolaufzeit"
End Sub


Sub AuszugNachher()
Dim t As Double
t = Time
Dim rngFund As Range
Dim rngNAV As Range
Dim arrErg
Dim i As Long
Dim Vergleich As Variant
Application.ScreenUpdating = False
Set rngFund = Sheets("Auszug_nachher").Range("B:G")
Set rngNAV = Sheets("Auszug_nachher").Range("B:B")
With Sheets("Auszug_vorher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
Vergleich = Application.Match(arrErg(i, 2), rngNAV, 0)
If Not IsError(Vergleich) Then
arrErg(i, 1) = rngFund.Cells(Vergleich, 6)
End If
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
MsgBox Timer - t & " sec", , "Makrolaufzeit"
End Sub

hast du evtl. eine Idee, wie es schneller sein kann?
Besten herzlichen dank!
Gruß
Mohsen

Anzeige
AW: es dauert 142 Minuten :)
23.04.2015 13:13:21
Shahed
Hallo Rudi,
also Der Code hat 71 Minuten gedauert. Da der Code zwei mal abgepielt wird (Auszug_vorher gegen Auszug_nachher und umgekehrt), dauert es 142 Minuten.
Sub AuszugVorher()
Dim t As Double
t = Time
Dim rngFund As Range
Dim rngNAV As Range
Dim arrErg
Dim i As Long
Dim Vergleich As Variant
Application.ScreenUpdating = False
Set rngFund = Sheets("Auszug_vorher").Range("B:G")
Set rngNAV = Sheets("Auszug_vorher").Range("B:B")
With Sheets("Auszug_nachher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
Vergleich = Application.Match(arrErg(i, 2), rngNAV, 0)
If Not IsError(Vergleich) Then
arrErg(i, 1) = rngFund.Cells(Vergleich, 6)
End If
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
MsgBox Timer - t & " sec", , "Makrolaufzeit"
End Sub

Sub AuszugNachher()
Dim t As Double
t = Time
Dim rngFund As Range
Dim rngNAV As Range
Dim arrErg
Dim i As Long
Dim Vergleich As Variant
Application.ScreenUpdating = False
Set rngFund = Sheets("Auszug_nachher").Range("B:G")
Set rngNAV = Sheets("Auszug_nachher").Range("B:B")
With Sheets("Auszug_vorher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
Vergleich = Application.Match(arrErg(i, 2), rngNAV, 0)
If Not IsError(Vergleich) Then
arrErg(i, 1) = rngFund.Cells(Vergleich, 6)
End If
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
MsgBox Timer - t & " sec", , "Makrolaufzeit"
End Sub

hast du evtl. eine Idee, wie es schneller sein kann?
Besten herzlichen dank!
Gruß
Mohsen

Anzeige
AW: es dauert 142 Minuten :)
23.04.2015 13:41:21
Daniel
Hi
Application.Match(...,...,0) ist auch noch eine starke Bremse, wenn der Durchsuchte Bereich sehr gross ist.
Du müssts die Tabelle "Auszug vorher" nach spalte B sortieren, dann könntest du mit Application.Match und 3. Parameter = 1 arbeiten.
Da dann aber kein Fehler erzeugt wird, wenn der Suchwert nicht in der Suchspalte vorkommt sondern der nächstkleinere Wert als Ergebnis verwendet wird, musst du den gefundenen Wert mit dem Suchwert vergleichen.
Als Formel mach ich dass dann immer so:
=Wenn(SVerweis(Suchwert;Suchspalte;1;wahr)=Suchwert;SVerweis(Suchwert;Suchmatrix;Ergebnisspalte;wahr) ;Alternativwert)
Das ist deutlich schneller, weil Excel hier aufgrund der Sortierung einen wesentlich schnellere Suchmethode verwendet als bei unsortierten Daten.
im Prinzip ist es so:
die Datenmenge sei N = 2^x.
Dann ist bei unsortierten Daten die Suchzeit im statistischen Mittel (jeder vorkommende Wert wird einmal gesucht) proportional N/2.
In Sortierten Daten ist die Suchzeit proportional x
Gruß Daniel

Anzeige
AW: es dauert 142 Minuten :)
23.04.2015 14:19:02
Shahed
Hallo Daniel,
zunächst vielen Dank für deine Hilfe.
also die Sortierung habe ich getan und teste jetzt. mit Sverweis komme ich nicht zum Ergebniss, da die Ergebnisspalte nicht in mienem Suchmatrix liegt. mit Index Vergleich muss ich zwei Schlüsselworten vergleichen (Zelle B1), wenn die übereinstimmen dann verlange ich den Wert von der Zelle G1. (Ich hoffe, dass ich dich richtig verstanden habe, bzw. du mich verstehst) lange rede kurzer Sinn...
kannst du bitte deine Idee nochmal im Code umschreiben?
also Spalte B von Sheet Auszug_vorher mit Spalte B von Sheet Auszug_nachher vergleichen wenn die übereinstimmen, dann soll die Spalte G von Sheet Auszug_vorher in der Spalte A von Sheet Auszug_vorher kommen.
Rudi Code hat perfekt funktioniert, es dauert aber hat sehr lang.
Besten Dank im Voraus!
Gruß
Shahed

Anzeige
AW: es dauert 142 Minuten :)
23.04.2015 14:32:07
Daniel
Hi
ich wüsste jetzt nicht, warum das nicht einfach mit dem SVerweis funktionieren sollte.
ausgehend von deiner Bescheibung probiere mal folgendes:
1. Sortiere die ganze Tabelle Auszug_Nachher (oder auch mehr) nach Spalte B
2. füge in die Tabelle Auszug_vorher in die Zelle A2 folgende Formel ein: 
=Wenn(SVerweis(B2;Auszug_Nachher!B:B;1;wahr)=B2;G2;"")

Gruß Daniel

AW: es dauert 142 Minuten :)
23.04.2015 15:07:32
Rudi
Hallo,
neues Konzept. 
Sub AuszugVorher()
Dim t As Double
t = Timer
Dim arrErg
Dim i As Long
Dim objNav As Object, arrNav
Set objNav = CreateObject("Scripting.dictionary")
With Sheets("Auszug_Vorher")
arrNav = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 6)
End With
For i = 1 To UBound(arrNav)
If Not objNav.exists(arrNav(i, 1)) Then
objNav(arrNav(i, 1)) = arrNav(i, 6)
End If
Next
Application.ScreenUpdating = False
With Sheets("Auszug_nachher")
arrErg = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
For i = 1 To UBound(arrErg)
arrErg(i, 1) = objNav(arrErg(i, 2))
Next i
.Cells(1, 1).Resize(UBound(arrErg), 2) = arrErg
End With
MsgBox Timer - t & " sec", , "Makrolaufzeit"
End Sub
bei 200.000 Zeilen ca. 4,3 Sek.
Gruß
Rudi

Anzeige
Hervorageng
23.04.2015 15:55:20
Shahed
Hallo Rudi,
woooow Genial, dieses Konzept funktioniert Hervorragend. :-)
ganz plausieble und Blitzschnell.
Danke SEHR, Du bist mein Retter !!!!!
Beste Grüße
Shahed

AW: läuft bei mir korrekt. owT
22.04.2015 16:17:37
Shahed
Sorry Stimmt, du hast vollkommend recht. Vielen Dank. wie gesagt, die Datei hat 200000 Zeile Daten, und die VBA braucht 45 minuten, kann man wegen der Preformance was machen?
Gruß
Shahed

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige