12.08.2023, 10:00
(Dieser Beitrag wurde zuletzt bearbeitet: 12.08.2023, 10:56 von WillWissen.
Bearbeitungsgrund: Codetags gesetzt
)
Hallo,
ich versuche folgendes hinzubekommen. Habe es in Visual Basic versucht. Vielleicht lässt es sich die Fragestellung auch einfacher lösen.
Zahlenreihe 1:
A1:A20 stehen 20 Zahlen
Zahlenreihe 2:
Z1:AS20 stehen 20 Zahlen
Ich möchte jetzt das die Werte aus Zahlenreihe 2 (Z1:AS20) mit Zahlenreihe 1 (A1:A20) abgeglichen werden und mit den Doppelten und den Nebenzahlen die sich aus Z1:AS20 in A1:A20 ergeben gelistet werden.
Ab AV1 die Werte aus Zahlenreihe 1 und ab BR 1 die Werte aus Zahlenreihe 2.
Habe mal versucht den Code dafür zu erstellen. Funktioniert aber leider nicht!!
Beispiel:
Zahlenreihe 1
A1:A20
4,6,7,9,14,18,28,32,36,39,40,41,50,52,54,55,57,59,61,66
Zahlenreihe 2
Z1:AS20
3,6,9,13,16,20,23,27,30,34,37,41,44,48,51,55,58,62,65,68
Ergebnis:
ab AV1:
4,6,7,9,14,28,36,40,41,50,52,54,55,57,59,61,66
ab BR1:
3,6,9,13,27,37,41,51,55,58,62,65
Was mache ich denn falsch? Habe wohl den Überblick verloren
![22 22](https://www.clever-excel-forum.de/images/smilies/pack 2/22.gif)
Gruss flicflac
ich versuche folgendes hinzubekommen. Habe es in Visual Basic versucht. Vielleicht lässt es sich die Fragestellung auch einfacher lösen.
Zahlenreihe 1:
A1:A20 stehen 20 Zahlen
Zahlenreihe 2:
Z1:AS20 stehen 20 Zahlen
Ich möchte jetzt das die Werte aus Zahlenreihe 2 (Z1:AS20) mit Zahlenreihe 1 (A1:A20) abgeglichen werden und mit den Doppelten und den Nebenzahlen die sich aus Z1:AS20 in A1:A20 ergeben gelistet werden.
Ab AV1 die Werte aus Zahlenreihe 1 und ab BR 1 die Werte aus Zahlenreihe 2.
Habe mal versucht den Code dafür zu erstellen. Funktioniert aber leider nicht!!
Code:
Sub FilterAndSort()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Blatt1")
Dim rngSource1 As Range, rngSource2 As Range
Set rngSource1 = ws.Range("A1:A20") ' Bereich der ersten Zahlenreihe
Set rngSource2 = ws.Range("Z1:AS20") ' Bereich der zweiten Zahlenreihe
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In rngSource2
If dict.Exists(cell.Value) Then
dict(cell.Value) = dict(cell.Value) + 1
Else
dict.Add cell.Value, 1
End If
Next cell
Dim resultArr() As Variant
ReDim resultArr(1 To dict.Count, 1 To 1)
Dim key As Variant, i As Long
i = 1
For Each key In dict.Keys
resultArr(i, 1) = key
i = i + 1
Next key
ws.Range("AV1").Resize(dict.Count, 1).Value = resultArr
' Sortieren
ws.Range("AV1").Sort Key1:=ws.Range("AV1"), Order1:=xlAscending, Header:=xlNo
' Clear Dictionary for the second set of numbers
Set dict = CreateObject("Scripting.Dictionary")
For Each cell In rngSource1
If dict.Exists(cell.Value) Then
dict(cell.Value) = dict(cell.Value) + 1
Else
dict.Add cell.Value, 1
End If
Next cell
ReDim resultArr(1 To dict.Count, 1 To 1)
i = 1
For Each key In dict.Keys
resultArr(i, 1) = key
i = i + 1
Next key
ws.Range("BR1").Resize(dict.Count, 1).Value = resultArr
' Sortieren
ws.Range("BR1").Sort Key1:=ws.Range("BR1"), Order1:=xlAscending, Header:=xlNo
End Sub
Beispiel:
Zahlenreihe 1
A1:A20
4,6,7,9,14,18,28,32,36,39,40,41,50,52,54,55,57,59,61,66
Zahlenreihe 2
Z1:AS20
3,6,9,13,16,20,23,27,30,34,37,41,44,48,51,55,58,62,65,68
Ergebnis:
ab AV1:
4,6,7,9,14,28,36,40,41,50,52,54,55,57,59,61,66
ab BR1:
3,6,9,13,27,37,41,51,55,58,62,65
Was mache ich denn falsch? Habe wohl den Überblick verloren
![22 22](https://www.clever-excel-forum.de/images/smilies/pack 2/22.gif)
![22 22](https://www.clever-excel-forum.de/images/smilies/pack 2/22.gif)
Gruss flicflac