Herbers CD 045799
27.07.2003 19:46:16
Erich M.
haber von Herbers CD nachstehenden Code:
Sub ListDoubles2()
' Herbers 045799
Dim rng As Range, rngCell As Range
Dim fct As WorksheetFunction
Dim var As Variant
Dim iRow As Integer
Set rng = ActiveSheet.UsedRange
Set fct = WorksheetFunction
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
For Each rngCell In rng.Cells
If fct.CountIf(rng, rngCell.Value) > 1 Then
var = Application.Match(rngCell.Value, Columns(1), 0)
If IsError(var) Then
iRow = iRow + 1
Cells(iRow, 1).Value = rngCell.Value
Else
iRow = var
End If
Cells(iRow, fct.CountA(Rows(iRow)) + 1).Value = _
rngCell.Address(False, False)
End If
Next rngCell
End Sub
Code eingefügt mit: Excel Code Jeanie
Ich versuche verzweifelt, dass die einträge in der neuen Tabelle in A2 statt in A1 beginnen und schaffe es nicht.
Vielen Dank für eine Hilfe!
mfg
Erich