Funktion benötigt

Bild

Betrifft: Funktion benötigt
von: Sascha H.
Geschrieben am: 25.11.2015 11:04:06

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"

Bild

Betrifft: AW: Funktion benötigt
von: Rudi Maintaire
Geschrieben am: 25.11.2015 11:54:47
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

Bild

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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Funktion benötigt"