Dictionary Items überschreiben
12.12.2017 12:17:00
Sandro
ich stehe leider vor einem Problem. Und zwar habe ich zum ausfüllen einer Matrix die Dictionary Funktion angewendet. Klappt soweit auch alles ganz gut bisher. Jetzt wollte ich aber bei der Erfassung der Daten in den Dictionary nicht nur Einträge erfassen die es bisher nicht gab sondern falls das neue Item kleiner als das bisherige Item im Dictionary ist dieses überschreiben.
Es handelt sich also um die Codezeilen
If dic.exists(a(i, 1))(a(i + 1, 1)) And a(i + 1, 3)
dic.Item(a(i, 1))(a(i + 1, 1)) = a(i + 1, 3)
End If
die mir Probleme bereiten.
Hier noch der ganze Code
Option Explicit
Sub Matrix()
Dim a, i As Integer, j As Long, dic As Object, ws As Worksheet
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
For Each ws In Worksheets([{"S1","S1.2","S2","S2.2","S3","S3.2","S5","S5.2","S7","S7.2","S8" _
_
,"S8.2","S9","S9.2","S25","S25.2","S41","S42","S45","S45.2","S46","S46.2","S47","S47.2","S75"," _
S75.2","S85","S85.2"}])
a = ws.[a3].CurrentRegion.Value
For i = 1 To UBound(a, 1) - 1
If Not dic.exists(a(i, 1)) Then
Set dic(a(i, 1)) = CreateObject("Scripting.Dictionary")
dic(a(i, 1)).CompareMode = 1
End If
dic(a(i, 1))(a(i + 1, 1)) = a(i + 1, 3)
If dic.exists(a(i, 1))(a(i + 1, 1)) And a(i + 1, 3)
Vielen Dank im Voraus :)