10.02.2017, 17:44 (Dieser Beitrag wurde zuletzt bearbeitet: 10.02.2017, 17:46 von Jockel.)
(10.02.2017, 17:40)lupo1 schrieb: Du kannst gern Dateien auch wieder löschen. Ich werde für diesen Wunsch allerdings immer belächelt...
Hi lupo1, es geht gar nicht um das Belächeln, sondern um Mehfach-uploads zum gleichen Thema. Das ist übrigens meine Meinung. Und muss nicht mit der Mehrheit übereinstimmen... ... Ohne Datei wäre es wohl hier schwierig zu helfen. Aber es müssen eben nicht drei Dateien sein..!!!
Gruß Jörg
ich muss mich erst wieder ganz langsam heran robben. Also bitte ich um Nachsicht
"Wer immer tut, was er schon kann, bleibt immer das, was er schon ist." - Henry Ford
-sverweis mit 2 Kriterien (in H2)
- index(vergleich()) mit Type WAHR, der einen sortierten Datendatz erfordert, aber dann zum schnellsten gehört, was xl zu bieten hat
in I2
Es ist einfach, das zuerst in ein Array zu übergeben.
Teste inbesondere die Formel aus I2 an einem begrenzten Datensatz.
hier der erste Ansatz für das Makro (es fehlt noch die Übergabe der Werte aus Tab1)
Code:
Sub Fen()
i=2
lr = Cells(Rows.Count, "A").End(xlUp).Row
Such = Application.Transpose(Range("D2:D" & lr))
Ergn = Application.Transpose(Range("C2:C" & lr))
Z = WorksheetFunction.Match(Cells(i, "F") & " " & CDbl(Cells(1, "G")), Such)
Debug.Print Z, Ergn(Z)
End Sub
Der Bezug ist meine Datei von vorhin.
mfg
Hallo Fennek,
tausend Dank für deine Mühen bisher! Sieht so aus, als fänden wir noch einen Weg. Es tut mir leid, aber du müsstest bitte ein klein wenig weiter ausholen. Ganz grob formuliert, was muss ich nacheinander tun?
Meine Vermutung: Laufzeit ca. 1 Minute auf einem relativ neuen Rechner.
Code:
Sub Fen()
Anf = Timer
Dim Such() As String
Dim OriD() As String
Dim N1() As String
'Daten aus Tabelle 2
lr2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
ReDim Such(lr2)
SpA2 = Application.Transpose(Sheets(2).Range("A2:A" & lr2))
SpB2 = Application.Transpose(Sheets(2).Range("B2:B" & lr2))
For i = LBound(SpA2) To UBound(SpA2)
Such(i) = SpA2(i) & " " & CDbl(SpB2(i))
Next i
Set SpA2 = Nothing
Set SpB2 = Nothing
'Such = Application.Transpose(Range("D2:D" & lr))
V2 = Application.Transpose(Sheets(2).Range("V2:V" & lr2))
Debug.Print "Tab 2", Timer - Anf
'
'Daten aus Tabelle 1
'
lr1 = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
ReDim OriD(lr1)
ReDim N1(lr1)
Ori = Application.Transpose(Sheets(1).Range("I2:I" & lr1))
Tim = Application.Transpose(Sheets(1).Range("M2:M" & lr1))
For i = LBound(Ori) To UBound(Ori)
OriD(i) = Ori(i) & " " & CDbl(Tim(i))
Next i
Set Ori = Nothing
Set Tim = Nothing
For i = LBound(OriD) + 1 To UBound(OriD) - 1
Z = WorksheetFunction.Match(OriD(i), V2)
N1(i) = V2(Z)
Next i
Sheets(1).Range("N1").Resize(lr1) = Application.Transpose(N1)
Sheets(1).Range("N1") = "Formel"
Debug.Print Timer - Anf
End Sub