Zusammenhänge aus A:B Kombi nach E:AB

Hallo alle zusammen,
ich bin mit meiner Idee bzw. Datei noch nicht da wo ich sein will und
habe eine (hoffentlich) einfache Frage an die VBAler:
Was versuche ich:
ich habe 4 Spalten mit Daten und ca. 80000 Zeilen
A1 ÜSchriften: Ab A2 Daten
Beispiel:
A2 = 886999777 / B2 = leer / C2 = 669977554 / D2 = 002222664
A3 = 886556677 / B3 = 556555888 / C3 = 111977554 / D3 = leer
A4 = 222999777 / B4 = leer / C4 = 886999777 / D4 = 445222264
A5 = 798499777 / B5 = 000255555 / C5 = leer / D5 = 886999777
usw.
Istdaten: Jede Zahl kann 1 oder mehrfach vorkommen.
Wie zu sehen: A2 = C4 & C4 = D5
SollDaten = in jeder Zeile sollen wenn es Zusammenhängende gibt alle Zahlen auch links und rechts daneben ab E2 geschrieben werden
zB:
A2 = 886999777 / B2 = leer / C2 = 669977554 / D2 = 002222664 steht und ab
E2 dann auch die = 445222264 (Zusammenhang ist A2 = C4) &
F2 dann auch die = 222999777 (Zusammenhang ist A2 = C4)
Und
A4 = 222999777 / B4 = leer / C4 = 886999777 / D4 = 445222264 steht und ab
E4 dann auch die = 669977554 (Zusammenhang ist A2 = C4) &
F2 dann auch die = 002222664 (Zusammenhang ist A2 = C4)
Ich habe das schon rudimentär mit 24 Such/Find Kombinationen (bis AC) folgender Formel:
Range("E2").FormulaR1C1 = "=IF(IFERROR(INDEX(C[-3],MATCH(RC[-2],C[-4],0)),"""")=0,"""",IFERROR(INDEX(C[-3],MATCH(RC[-2],C[-4],0)),""""))"
.Range("E2:AC" & letzte).FillDown
Mit einer Sub von Daniel "Listen_ohne_Duplikate" (Danke nochmal)
lasse ich mir dann eine Bereinigte Liste ausgeben.
Das läuft soweit und langsam und ich denke ständig ich habe etwas bei den Index Kombinationen übersehen.
Ein VBA Fctn oder SripctionDic könnte mir da mehr Sicherheit reinbringen und ist bestimmt auch einen Zacken schneller!?
Mir gehts vor allem darum dass ich eben nichts übersehe und in jeder Datenreihe immer alle Zusammenhänge link-Mitte-rechts, egal ob Anfang, Mitte oder Ende, einfangen kann.
Ich hoffe das war soweit verständlich erklärt.
Anbei noch die Datei
https://www.herber.de/bbs/user/106808.zip
Danke schon mal im Voraus
Nilo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub test() Dim letzte&, z&, s&, i&, sW&, sI&, sA& '&= As Long Dim arr, aus, dic As Object, kD Dim spB, wT ' SpaltenBuchstaben, wasTun Dim wTp0&, m& Dim st$ Dim zA, zB spB = Array("A", "B", "C", "D") wT = "!CA24!AC24!DA23!AD23!BA34!AB34!CB14!BC14!DC12!CD12!DB13!BD13" letzte = ActiveSheet.Cells(65000, 1).End(xlUp).Row arr = Range("A1:D" & letzte) Range("E2:AB" & letzte).Clear aus = Range("E2:AB" & letzte) Set dic = CreateObject("scripting.dictionary") For s = 1 To 4 For z = 2 To letzte If arr(z, s) "" Then st = spB(s - 1) & arr(z, s) dic(st) = dic(st) & z & "," End If Next Next For Each kD In dic.keys wTp0 = 0 For i = 1 To 3 wTp0 = InStr(wTp0 + 1, wT, "!" & Mid(kD, 1, 1)) st = Mid(wT, wTp0 + 2, 1) & Mid(kD, 2) sA = (wTp0 - 1) / 2.5 + 1 '1,6,11,... ' MsgBox sA & ": " & kD & " " & st If dic.exists(st) Then zA = Split(dic(kD), ",") zB = Val(Split(dic(st), ",")(0)) For m = 0 To UBound(zA) - 1 aus(Val(zA(m)) - 1, sA) = arr(zB, Val(Mid(wT, wTp0 + 3, 1))) aus(Val(zA(m)) - 1, sA + 1) = arr(zB, Val(Mid(wT, wTp0 + 4, 1))) Next End If Next Next Range("E2:AB" & letzte) = aus End Sub

For s = 1 To 4 ' schnappe Dir die Spalten 1 bis 4 For z = 2 To letzte ' und alle Zeilen ohne die Überschrift If arr(z, s) "" Then ' wenn das nicht leer ist, dann st = spB(s - 1) & arr(z, s) ' hole Dir den Spaltenbuchstaben aus spB ' spB enthält die vier Buchstaben, wobei ' spB(0)="A" bis spB(3)="D", deshalb s-1 ' und stelle sie VOR den eigentlichen Wert ' Ein Dictionary besteht aus Paaren von "Keys", das ist das, was in der ' Klammer steht, also st, z.B. "B12345" und "Items", also dem Wert, in ' dem Fall die Zeilennummer. ' Dics enthalten immer nur EINDEUTIGE Keys, d.h., Begriffe können NICHT ' mehrfach vorkommen. dic(st) = dic(st) & z & "," ' das bedeutet: wenn ein Begriff noch nicht ' vorhanden ist, lege ihn mit der Zeilennr. an ' wenn er bereits existiert, füge die Nr. der ' nächsten, gefundenen Zeile an. End If Next Next

Beliebteste Forumthreads (12 Monate)

Zusammenhänge aus A:B Kombi nach E:AB

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread