Hallo EXCEL-Freunde,
hallo Sepp,
habe einen Code, der Originale und Duplikate findet. Das ganze findet
innerhalb einer längeren Prozedur statt und die betroffenen Spalten werden
mit UserForm variabel ausgewählt.
Wenn ich dabei die "zu prüfenden Werte" in Spalte A habe, läuft alles
wunderbar. Wenn ich aber die werte in B, C, D usw. habe, werden die
Ergebnisse immer in eine "Spalte + 1" (bei B), Spalte + 2 (bei C) usw.
eingetragen.
Ich habe schon alles mögliche probiert, aber komme nicht weiter; auch eine
zweite Variante von Sepp hat nicht geholfen.
Ich habe nun den Teil aus dem UF-code rauskopiert und hier eingestellt.
Vielleicht kann ja jemand das Problem erkennen. Noch ein Hinweis:
die Spalten habe ich einmal mit String und einmal mit Integer deklariert;
habe auch hier schon unterschiedlich abgeprüft ohne Erfolg!
Im code entscheidend sind:
ComboBox4: = Suchspalte (letzteSpalte)
ComboBox5: = Spalte ab der eingetragen wird (neueSpalte)
Private Sub CommandButton1_Click()
Dim Tab1 As Worksheet, myName1 As String, myDatei As String, neueSpalte As Integer
Dim letzteSpalte As String, mySpalte2 As Integer
Dim Tb(1 To 15) As Worksheet, zeile As Long, strBuchstaben As String, intNummer As Integer, rng As Range
Dim iRow As Integer, iRowL As Integer, myZeile As Long, r As Range, intSpalte As Integer
Dim zeile2 As Long, zeile1 As Long
Dim a As Long, b As Long, MyCol As Integer, MyCol2 As Integer, i As Integer, Tab3 As Worksheet, MyCol3 As String
Dim AM As Workbook, strspalte(1 To 256) As String

If ComboBox1.Text = "" Then MsgBox "Bitte Datei auswählen.", 48, "Hinweis": Exit Sub
If ComboBox2.Text <> "" Then Set Tb(1) = Workbooks(ComboBox1.Text).Worksheets(ComboBox2.Text) _
Else MsgBox "Bitte Tabellenblatt 1 auswählen.", 48, "Hinweis": Exit Sub
If ComboBox4 = "" Then MsgBox "Bitte Suchspalte auswählen.", 48, "Hinweis": Exit Sub
If ComboBox5 = "" Then MsgBox "Bitte Spalte auswählen ab der eingetragen werden soll.", 48, "Hinweis": Exit Sub
If ComboBox6 <> "" And OptionButton2 = False Then MsgBox "Sie haben die falsche Variante gewählt " & Chr(13) & _
" - wollen Sie WV-Bezeichnung prüfen?.", 48, "Hinweis": Exit Sub
If OptionButton2 = True Then
If ComboBox6 = "" Then MsgBox "Bitte Suchspalte für WV-Bezeichnung auswählen.", 48, "Hinweis": Exit Sub
End If
' Umwandlung Spalte Buchstabe in Zahl
strBuchstaben = ComboBox5.Text ' ab dieser Spalte wird eingetragen
If Len(strBuchstaben) = 1 Then
intNummer = Asc(strBuchstaben) - 64
Else
intNummer = (Asc(Left(strBuchstaben, 1)) - 64) * 26
intNummer = intNummer + Asc(Right(strBuchstaben, 1)) - 64
End If
neueSpalte = CStr(intNummer)
Application.ScreenUpdating = False
myDatei = ComboBox1.Text ' Datei in der gesucht wird
myName1 = ComboBox2.Text ' Suchtabelle
letzteSpalte = ComboBox4.Text ' Suchspalte mehrfach
Workbooks(ComboBox1.Text).Activate
Worksheets(myName1).Activate
myZeile = Range("A65536").End(xlUp).Row
Set Tab1 = Sheets(ComboBox2.Text) ' = Ausgangstabelle, Suchtabelle
' mehrfach markieren
iRowL = Cells(Cells.Rows.Count, letzteSpalte).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Columns(letzteSpalte), Cells(iRow, letzteSpalte)) = 1 Then
Cells(iRow, neueSpalte) = "einfach"
End If
If WorksheetFunction.CountIf(Columns(letzteSpalte), Cells(iRow, letzteSpalte)) > 1 Then
Cells(iRow, neueSpalte) = "mehrfach in Spalte " & letzteSpalte
End If
Next iRow

' Variante 1 von Josef Ehrensberger; Aufteilung Original oder Duplikat
' http://www.herber.de/forum/archiv/412to416/t415875.htm
'' kein Problem: wenn letzteSpalte = A;
''' Problem: wenn letzteSpalte = B, dann neueSpalte = neueSpalte +1;
' wenn letzteSpalte = C, dann neueSpalte = neueSpalte + 2 usw.
Dim Zelle As Range, lngR As Long, lngC As Long
Range(Cells(1, letzteSpalte), Cells(myZeile, letzteSpalte)).Select
If Selection.Columns.Count > 1 Then Selection.Columns(1).Select
Set rng = Selection
lngR = rng.Rows.Count
For Each Zelle In rng
For lngC = 1 To lngR
With Zelle
If .Value <> "" And .Offset(, neueSpalte) <> "Original" _
And .Offset(, neueSpalte) <> "Duplikat" Then
If Zelle = rng(lngC) Then
Zelle.Offset(, neueSpalte) = "Duplikat"
rng(lngC).Offset(, neueSpalte) = "Original"
End If
End If
End With
Next
Next
' Variante 2 von Josef Ehrensberger
Set rng = Range(Cells(1, letzteSpalte), Cells(myZeile, letzteSpalte))
lngR = rng.Rows.Count
For Each Zelle In rng
For lngC = 1 To lngR
With Zelle
If .Value <> "" And Left(.Offset(, neueSpalte + 2), 0) <> "O" _
And Left(.Offset(, neueSpalte + 2), 0) <> "D" _
And WorksheetFunction.CountIf(rng, rng(lngC)) > 1 Then
If Zelle = rng(lngC) Then
Zelle.Offset(, neueSpalte + 2) = "Duplikat"
rng(lngC).Offset(, neueSpalte + 2) = "Original"
End If
End If
End With
Next
Next
Application.ScreenUpdating = True
Unload Me
Worksheets(myName1).Activate
Range(Cells(1, neueSpalte), Cells(1, neueSpalte + 5)).EntireColumn.AutoFit
Range("A1").Select
End Sub

Besten Dank für eine Hilfe!
mfg
Erich