Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<

Microsoft Office 2003-2019 => Excel => Thema gestartet von: KaGe am November 05, 2017, 15:11:51 Nachmittag

Titel: Office 2013: Spalten von zwei Arbeitsmappen vergleichen
Beitrag von: KaGe am November 05, 2017, 15:11:51 Nachmittag
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
Titel: Antw: Office 2013: Spalten von zwei Arbeitsmappen vergleichen
Beitrag von: maninweb am November 06, 2017, 08:58:53 Vormittag
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ß
Titel: Office 2013: Antw: Office 2013: Spalten von zwei Arbeitsmappen vergleichen
Beitrag von: KaGe am November 08, 2017, 21:17:16 Nachmittag
Hallo,
anbei habe ich jetzt noch die beiden Sheets als Beispiel hochgeladen.
Ich hoffe, dass es nun verständlicher ist.

Gruß,
Gerald
Titel: Antw: Office 2013: Spalten von zwei Arbeitsmappen vergleichen
Beitrag von: maninweb am November 09, 2017, 14:04:52 Nachmittag
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ß
Titel: Office 2013: Antw: Office 2013: Spalten von zwei Arbeitsmappen vergleichen
Beitrag von: KaGe am November 09, 2017, 23:48:16 Nachmittag
Hallo maninweb,

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


Gruß,
Gerald