Gruppe
Dialog
Problem
In einer Tabelle doppelt vorkommende Werte sollen in einer UserForm-ComboBox gelistet werden.
ClassModule: frmSuchen
Private Sub cmdSuchen_Click()
Dim rng As Range
Dim iRowL As Integer, iCol As Integer
Application.ScreenUpdating = False
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
iCol = Cells(1, 256).End(xlToLeft).Column + 1
Cells(1, iCol).Formula = "=countif(A:A,A1)"
Range(Range(Cells(1, iCol), Cells(iRowL, iCol)).Address).FillDown
Range("A1").CurrentRegion.AutoFilter field:=iCol, Criteria1:=">1"
Set rng = Columns(1).CurrentRegion.SpecialCells(xlCellTypeVisible)
Workbooks.Add
rng.Copy Range("A1")
Rows(1).Delete
cboDoubles.List = Range("A1").CurrentRegion.Columns(1).Value
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ActiveSheet.AutoFilterMode = False
Columns(iCol).ClearContents
If cboDoubles.ListCount > 0 Then cboDoubles.ListIndex = 0
End Sub
Private Sub cmdWeiter_Click()
Unload Me
End Sub
StandardModule: basMain
Sub CallForm()
frmSuchen.Show
End Sub