|
Anbei die Lösung zum kopieren in eine andere Tabelle
Public Sub main()
Dim colResult As Collection
Dim cFactory As New clsDataFactory
Dim cMatch As clsMatch
Dim i As Integer
Sheets.Add.Name = "ŸbereinstimmendeEintrŠge"
cFactory.dataFactory "Tabelle1"
Set colResult = cFactory.getMatchingItems
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 1).FormulaR1C1 = "Datum"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 2).FormulaR1C1 = "Nachname"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 3).FormulaR1C1 = "Vorname"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 4).FormulaR1C1 = "Ja/Nein"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 6).FormulaR1C1 = "Nachname"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 7).FormulaR1C1 = "Vorname"
Worksheets("ŸbereinstimmendeEintrŠge").Cells(1, 8).FormulaR1C1 = "Ja/Nein"
If Not colResult Is Nothing Then
i = 2
For Each cMatch In colResult
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 1).FormulaR1C1 = cMatch.Data1.Datum
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 2).FormulaR1C1 = cMatch.Data1.Nachname
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 3).FormulaR1C1 = cMatch.Data1.Vorname
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 4).FormulaR1C1 = cMatch.Data1.JaNein
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 6).FormulaR1C1 = cMatch.Data2.Nachname
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 7).FormulaR1C1 = cMatch.Data2.Vorname
Worksheets("ŸbereinstimmendeEintrŠge").Cells(i, 8).FormulaR1C1 = cMatch.Data2.JaNein
i = i + 1
Next cMatch
End If
Set colResult = Nothing
Set cFactory = Nothing
End Sub
|