[SuperWolf]

Tabelle 1 basiert schon auf einer Art Menü, jedoch ist dies theoretisch erweiterbar.

Tabelle 2 beinhaltet Textvariablen aus SAP und ist relativ fix. Allerdings kann auch hier noch etwas ergänzt werden.

Ich veruche mich grad an einem VBA-Code der auch schon teilweise funktioniert. Werde den dann eventuell noch ins Forum stellen.

Dieser Beitrag wurde von SuperWolf bearbeitet: 01. März 2012 - 12:15

[SuperWolf]

Also ich sag es mal so....es funktioniert, allerdings kann nicht bewerten wie gut bzw. optimiert der Quellcode ist.

Option Explicit
Option Base 1

Public Sub Matching_OTR_ZP25()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim arr1() As Variant
Dim arr2() As Variant
Dim i As Long
Dim j As Long
Dim k As Integer
Dim l As Integer
Dim zeile_ws1 As Long
Dim zeile_ws2 As Long

On Error GoTo Error



'2 Tabellen den variablen zuordnen
Set ws1 = ActiveWorkbook.Sheets("Overview")
Set ws2 = ActiveWorkbook.Sheets("OTR_ZP25")

'alle Zellen anzeigen
ws1.Cells.EntireColumn.Hidden = False
ws2.Cells.EntireColumn.Hidden = False

'letzte benutzte Zelle in "Overview" Spalte D finden
With ws1
zeile_ws1 = .Cells(Rows.Count, 4).End(xlUp).Row
End With

'letzte benutzte Zelle in "OTR_ZP25" Spalte A finden
With ws2
zeile_ws2 = .Cells(Rows.Count, 1).End(xlUp).Row
End With



'Array mit den Werten in allen Zeilen der Spalte D aus "Overview" befüllen

i = 3

Do
ReDim Preserve arr1(i)
arr1(i) = ws1.Cells(i, 4)
i = i + 1
Loop Until i > zeile_ws1



'Array mit den Werten in allen Zeilen der Spalte A aus "OTR_ZP25" befüllen

j = 2

Do
ReDim Preserve arr2(j)
arr2(j) = ws2.Cells(j, 1).Value
j = j + 1
Loop Until j > zeile_ws2





' Spaltenvariablen festlegen (jeweils ab Spalte C bzw. H)
k = 3
l = 8

'wenn Zelle in "Overview" gleich der Zelle in "OTR_ZP25" dann schaue ob in "overview" eine zelle in den spalten c-m beschrieben ist,
'die in den in "otr" enstsprechenden zellen leer ist und übernehme diese zelle in "otr"

For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2) To UBound(arr2)
Do
        If (arr1(i) = arr2(j)) Then
        
            If ws2.Cells(j, k) = "" Then
            ws2.Cells(j, k) = ws1.Cells(i, l).Value
            End If
        
        End If
        
        k = k + 1
        l = l + 1
        
Loop Until k > 8
    
    k = 3
    l = 8
    
    
    Next j
 Next i
    


'Vergleiche jede Stelle des 1. Arrays mit jeder Stelle des 2. Arrays

For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr2) To UBound(arr2)
    
'Überspringe Leerstellen (Es sind in "Overview" teilweise leere Zeilen in der Spalte D, diese
'sind zwar auch im Array (unnötiger Speicherverbrauch awa is ja keine große Datei) werden hier
'aber übersprungen

        If arr1(i) = vbNullString Then
        i = i + 1
        Else
        
'wenn Zelle in "Overview" gleich der Zelle in "OTR_ZP25" dann übernehme die Werte aus den Spalten
'c-h aus "OTR" und füge in h-m in "Overview"

            If (arr1(i) = arr2(j)) Then
            ws1.Range("H" & i & ":M" & i) = ws2.Range("C" & j & ":H" & j).Value
            
            
             End If
        End If
    Next j
        
Next i





'Falls Fehler auftreten zeige "Stop" an

Exit Sub
Error:
Debug.Print Err.Description

MsgBox "Stop: Error!"



End Sub