Office 2013: Spalten von zwei Arbeitsmappen vergleichen

[KaGe]

Hallo,
es geht um zwei Arbeitsblätter in Excel 2013 in denen ich 2 Spalten mit Hilfe von VBA vergleichen will.
In der ersten Arbeitsmappe (wksQ) Sheet(1) sind in Spalte D Zahlen. Diese Spalte enthält auch Leerzellen!
Die zweite Arbeitsmappe (wksZ) Sheet(2), Spalte C ist schon mit Daten gefüllt. Zeilen ohne Leerzellen.
Die Zahlenwerte können in beiden Spalten mehrfach vorkommen.
Nun soll die Spalte D von wksQ mit der Spalte C von wksZ verglichen werden.
Wenn nun ein Wert von wksQ/Spalte D nicht in wksZ/Spalte C enthalten ist,
soll von wksQ die Zeile von Spalte C bis I in die nächste frei Zeile von wksZ von Spalte B bis H kopiert werden.
Hab schon einiges durchstöbert. Finde leider nicht das Richtige.
Ich hoffe mir könnte einer helfen.


Gruß,
Gerald

[maninweb]

Hallo,

eine Beispieldatei mit ein paar Daten könnte hier hilfreich sein. Unabhängig davon,
ob nun ich oder jemand anderes hier unterstützt.

Gruß

[KaGe]

Hallo,
anbei habe ich jetzt noch die beiden Sheets als Beispiel hochgeladen.
Ich hoffe, dass es nun verständlicher ist.

Gruß,
Gerald

[maninweb]

Hallo,

anbei ein Code, auf dem Du aufbauen kannst. Nebenbei, die Spalten entsprechen nicht der Beschreibung
in Deiner ursprünglichen Frage. Code musst Du an Deine Gegebenheiten anpassen.

Code: Visual Basic

1.   Public Sub CopyData()
2.  
3.     Dim wksSource   As Worksheet
4.     Dim wksTarget   As Worksheet
5.    
6.     Dim objTarget   As Collection
7.     Dim arrTarget   As Variant
8.    
9.     Dim lngCurrent  As Long
10.     Dim lngIndex    As Long
11.    
12.     Dim strKey      As String
13.    
14. '   Disable errors...
15.    
16.     On Error Resume Next
17.    
18. '   Sheets...
19.    
20.     Set wksSource = Application.Workbooks("wksQ.xlsx").Worksheets("Budget")
21.     Set wksTarget = Application.Workbooks("wksZ.xlsx").Worksheets("DATA_HW")
22.    
23. '   Validate...
24.    
25.     If Not wksSource Is Nothing And Not wksTarget Is Nothing Then
26.      
27. '     Create...
28.      
29.       Set objTarget = New Collection
30.      
31. '     Target range...
32. '
33. '     Das könnte dynamisiert werden, z.B. in Höhe = aktuelle
34. '     Höhe + Höhe von Quelle, so dass ein maximaler Bereich
35. '     ensteht
36.      
37.       arrTarget = wksTarget.Range("A4:H999").Value
38.      
39. '     Loop through target...
40.      
41.       For lngIndex = LBound(arrTarget, 1) To UBound(arrTarget, 1)
42.        
43.         If Len(arrTarget(lngIndex, 2)) > 0 And _
44.            Len(arrTarget(lngIndex, 3)) > 0 Then
45.          
46.           lngCurrent = lngCurrent + 1
47.          
48.           objTarget.Add CStr(lngIndex), _
49.           arrTarget(lngIndex, 2).Value & "-" & _
50.           arrTarget(lngIndex, 3).Value
51.          
52.         Else
53.          
54.           Exit For
55.          
56.         End If
57.        
58.       Next
59.      
60. '     Loop through source...
61. '
62. '     Auch das könnte dynamisiert werden, so dass die Obergrenze
63. '     per Code festgelegt wird
64.      
65.       For lngIndex = 2 To 19
66.        
67.         If Len(wksSource.Cells(lngIndex, 2).Value) > 0 And _
68.            Len(wksSource.Cells(lngIndex, 3).Value) > 0 Then
69.            
70.           strKey = ""
71.           strKey = objTarget(wksSource.Cells(lngIndex, 2).Value & "-" & _
72.                              wksSource.Cells(lngIndex, 3).Value)
73.          
74.           If Len(strKey) < 1 Then
75.            
76.             lngCurrent = lngCurrent + 1
77.            
78.             arrTarget(lngCurrent, 1) = lngCurrent
79.             arrTarget(lngCurrent, 2) = wksSource.Cells(lngIndex, 2).Value
80.             arrTarget(lngCurrent, 3) = wksSource.Cells(lngIndex, 3).Value
81.             arrTarget(lngCurrent, 4) = wksSource.Cells(lngIndex, 4).Value
82.             arrTarget(lngCurrent, 5) = wksSource.Cells(lngIndex, 5).Value
83.             arrTarget(lngCurrent, 6) = wksSource.Cells(lngIndex, 6).Value
84.             arrTarget(lngCurrent, 7) = wksSource.Cells(lngIndex, 7).Value
85.             arrTarget(lngCurrent, 8) = wksSource.Cells(lngIndex, 8).Value
86.            
87.           End If
88.        
89.         End If
90.        
91.       Next
92.      
93. '     Write...
94.      
95.       wksTarget.Range("A4:H999").Value = arrTarget
96.      
97. '     Clear...
98.      
99.       Set objTarget = Nothing
100.      
101.     Else
102.    
103.       MsgBox "Beide Mappen müssen offen sein.", vbOKOnly
104.      
105.     End If
106.    
107.   End Sub

Gruß

[KaGe]

Hallo maninweb,

Genial!!
Vielen, vielen Dank!
Konnte es anpassen und funktioniert einwandfrei.


Gruß,
Gerald