PDA

Vollständige Version anzeigen : Liste mit Dictionary vergleichen


kallepohl
30.06.2015, 10:22
Hallo zusammen. Ich zerbreche mir jetzt schon eine ganze Weile den Kopf und komme einfach nicht weiter. Ich habe folgendes Problem.
Ich habe eine Excel Datei, in die Daten geschrieben werden sollen. Dazu öffnet ein Macro eine weitere Excel Datei, geht zu einem bestimmten Sheet in dieser Datei und soll dann durch die einzelnen Zeilen gehen und in Spalte D jeder Zeile den Wert dieser Zelle mit einer Liste vergleichen. Kommt der Wert in der Liste vor, soll aus dieser Zeile Spalte A:I in meine Datei kopiert werden. In meiner Datei wird dann eine neue Zeile angewählt und wenn es wieder einen Treffer in der anderen Datei gibt, wird das ganze wiederholt.
Die Liste, mit der verglichen werden soll, hab ich in meiner Datei stehen. Da ich aber nicht weiss, wie ich diese Liste ansprechen kann, habe ich in meinem Code die 27 einzelnen Elemente in ein Dictionary Object geschrieben (k.A. ob ich das richtig gemacht habe).
Hier mein bisheriger Code.

'Import data from Market Segments tab
DE.Activate 'DE habe ich das Workbook genannt, aus dem die Daten kopiert werden sollen
'Create Object - Dictionary for market codes
Dim oSegList As Object
Set oSegList = CreateObject("Scripting.Dictionary")
'Add market codes to dictionary; das sind die Werte, mit denen verglichen werden soll
oSegList.Add "CIB", 1
oSegList.Add "CIC", 2
oSegList.Add "CIG", 3
oSegList.Add "CIP", 4
oSegList.Add "CIV", 5
oSegList.Add "GCD", 6
oSegList.Add "GCG", 7
oSegList.Add "GGV", 8
oSegList.Add "GID", 9
oSegList.Add "GIG", 10
oSegList.Add "GMD", 11
oSegList.Add "GMG", 12
oSegList.Add "GSM", 13
oSegList.Add "MCC", 14
oSegList.Add "MPR", 15
oSegList.Add "PMR", 16
oSegList.Add "TBR", 17
oSegList.Add "TDS", 18
oSegList.Add "TIM", 19
oSegList.Add "TPK", 20
oSegList.Add "WFK", 21
oSegList.Add "WFO", 22
oSegList.Add "WTA", 23
oSegList.Add "WTS", 24
oSegList.Add "ZCO", 25
oSegList.Add "ZCR", 26
oSegList.Add "ZHO", 27



lSource = WorksheetFunction.CountA(ActiveWorkbook.Sheets("Market Segments").Range("A:A"))
lTool = WorksheetFunction.CountA(ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range("A:A"))

ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range("A2:I" & lTool).ClearContents 'MARKET_SEGMENTS_SHEET ist das Sheet in meiner Datei, auf das die Werte aus der anderen Datei gepastet werden sollen; vorher lösche ich die Werte, die bisher da standen

'Import data
DE.Activate
Sheets("Market Segments").Activate

Dim iSourceRows As Integer
Dim iToolRow As Integer
Dim UsedRng As Range
Dim LastRow As Long
Dim LookUpRng As Range
Set UsedRng = ActiveSheet.UsedRange
LastRow = UsedRng(UsedRng.Cells.Count).row
LookUpRng = ActiveWorkbook.Sheets("Market Segments").Range(Cells(iSourceRows, 4)) 'hier bekomme ich einen Fehler
iToolRow = 2
For iSourceRows = 2 To LastRow
If oSegList.Exists(Trim(LookUpRng.value)) Then 'Exists wurde nicht automatisch gross geschrieben, daher weiss ich nicht, ob dieser Befehl überhaupt erkannt wurde
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 1)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 1))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 2)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 2))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 3)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 3))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 4)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 4))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 5)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 5))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 6)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 6))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 7)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 7))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 8)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 8))
ThisWorkbook.Sheets(MARKET_SEGMENTS_SHEET).Range(Cells(iToolRow, 9)).value = DE.Sheets("Market Segments").Range(Cells(iSourceRows, 9))

iToolRow = iToolRow + 1
End If
Next iSourceRows


Hat irgendeiner eine Idee, was ich hier alles falsch mache? Wenn es eine leichtere Lösung gibt, dann bin ich dafür natürlich auch dankbar. Das ist leider komplettes Neuland für mich.

Vielen Dank im Voraus.