Gruppe
Funktion
Problem
In Spalte B sollen die korrespondierenden Zahlenzuordnungen aus Tabelle2 übernommen werden.
StandardModule: basMain
Sub KopierenOhneDoppelte()
Dim wks As Worksheet
Dim iRow As Integer, iCol As Integer, iRowT As Integer
Set wks = Worksheets("Tabelle2")
iRow = 1
iCol = 1
wks.Columns("A").ClearContents
Do Until IsEmpty(Cells(iRow, iCol))
Do Until IsEmpty(Cells(iRow, iCol))
If WorksheetFunction.CountIf( _
wks.Columns(1), Cells(iRow, iCol).Value) = 0 Then
iRowT = iRowT + 1
wks.Cells(iRowT, 1).Value = Cells(iRow, iCol).Value
End If
iCol = iCol + 1
Loop
iRow = iRow + 1
iCol = 1
Loop
End Sub