Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1460to1464
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

Funktion benötigt

Funktion benötigt
25.11.2015 11:04:06
Sascha
Hallo zusammen!
Ich habe jetzt ein etwas komplexeres Anliegen. Da meine VBA-Kenntnisse dürftig sind, brauche ich für die Umsetzung einer bestimmten Funktion ziemlich viele Umwege. Ich hoffe Ihr könnt mir dabei vielleicht helfen.
Meine Absicht ist Folgende:
- Ich habe eien Range in der Werte stehen (Bsp.: Range("D19:D27"))
- Als erstes möchte ich, dass ich ein Array erhalte mit allen Werten aus der Range
- Als nächstes möchte ich, dass zu jedem Wert in diesem Array ein weiterer Wert gespeichert wird (2-dimensionales Array). Dieser zweite Wert wird ebenfalls aus einer Range ausgelesen. Da beide Ranges immer die gleiche Anzahl Zellen haben und die Werte immer in der selben Zeile stehen, könnte man sagen Position 1 aus Range A ist = Position 2 aus Range B
- Nun möchte ich alle Werte die in der ersten Dimension doppelt sind auf 1 Vorkommen reduzieren. Dabei ist es aber wichtig dass alle Werte aus der 2 Dimension erhalten bleiben.
Bsp:
[ARRAY]
(0,0) = "Test 1"
(1,0) = "Test 2"
(2,0) = "Test 1"
(0,1) = "Wert 1 für Test 1"
(1,1) = "Wert 1 für Test 2"
(2,1) = "Wert 2 für Test 1"
Daraus soll werden:
(0,0) = "Test 1"
(1,0) = "Test 2"
(0,1) = "Wert 1 für Test 1"
(0,2) = "Wert 2 für Test 1"
(1,1) = "Wert 1 für Test 2"

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Funktion benötigt
25.11.2015 11:54:47
Rudi
Hallo,
teste mal:
Sub yyy()
Dim x
x = TestArray(Range("A2:A7"), Range("B2:B7"))
End Sub
Function TestArray(R1 As Range, R2 As Range)
Dim A1, A2
Dim oTmp As Object, arrTmp, i As Integer, j As Integer
Dim vKey, d
Set oTmp = CreateObject("Scripting.Dictionary")
A1 = R1.Value
A2 = R2.Value
For i = 1 To UBound(A1)
oTmp(A1(i, 1)) = oTmp(A1(i, 1)) & "|" & A2(i, 1)
Next
For Each vKey In oTmp
d = WorksheetFunction.Max(d, UBound(Split(Mid(oTmp(vKey), 2), "|")))
Next
ReDim arrTmp(oTmp.Count - 1, d + 1)
i = 0
For Each vKey In oTmp
arrTmp(i, 0) = vKey
For j = 0 To UBound(Split(Mid(oTmp(vKey), 2), "|"))
arrTmp(i, j + 1) = Split(Mid(oTmp(vKey), 2), "|")(j)
Next
i = i + 1
Next
TestArray = arrTmp
End Function
Gruß
Rudi

Anzeige
AW: Funktion benötigt
25.11.2015 13:37:58
Sascha
WOW! Das ist richtig gut. Ich verstehe zwar nur die Hälfte, aber es funktioniert :). Tolle Arbeit!
Riesen Dank Rudi!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige