Sub
columnistgleich()
Dim
arrdata, arrbase, serg$, arrerg
Dim
i&, cnt&, ii&
arrbase = Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(
"C"
))
arrdata = ActiveSheet.UsedRange
For
i = 1
To
UBound(arrdata, 2)
For
cnt = 1
To
UBound(arrbase)
If
arrbase(cnt, 1) <> arrdata(cnt, i)
Then
Exit
For
Next
If
cnt > UBound(arrbase)
Then
serg = serg & i &
","
Next
If
Len(serg) > 0
Then
serg = Left(serg, Len(serg) - 1)
With
Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name =
"Ergebnis"
.Range(
"A1"
) =
"Übereinstimmende Spalten (Spaltennummer)"
arrerg = Split(serg,
","
)
.Range(
"A2"
).Resize(UBound(arrerg) + 1).Value = Application.Transpose(arrerg)
End
With
End
Sub