2.2k Aufrufe
Gefragt in Tabellenkalkulation von flori006 Einsteiger (88 Punkte)
Ich wünsche einen schönen Tag,

und hätte mal wieder ein Problem.

In einem vorhandenen Makro einer Exceltabelle möchte ich eine andere Funktion einbauen. Zum besseren Verständnis anschließend den Code:

Sub Prüfen1()
Dim Letzte_Zeile As Long, Wiederholungen As Long
Letzte_Zeile = Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
For Wiederholungen = Letzte_Zeile To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(Wiederholungen, 1)), _
Cells(Wiederholungen, 1)) > 1 Then
MsgBox "Gearbeitet"
MsgBox "Gelöscht"
Range("A" & Range("A65536").End(xlUp).Row).ClearContents
End If
Next
End Sub

Es wird also in D1 ein Wert eingegeben der mit einem Speicherbutton (Makro) fortlaufend in Spalte A abgespeichert wird.
Mit dem oben zu sehendem Makro überprüfe ich dann ob der Eintrag schon vorhanden ist. Über die Messageboxen lässt sich dieser dann löschen.
Ich möchte aber erreichen, das nach der Eingabe in D1 und dem anschließenden Abspeichern nach Spalte A mir sofort bei einem schon vorhandenen Duplikat , diese Zeile mit dem Duplikat angezeigt und nach oben (z.B. ab Zeile 2) gescrollt wird um diesen weiter zu bearbeiten. Es sollen also keine doppelten Einträge vorkommen ! Wenn der Eintrag noch nicht vorhanden ist, soll er wie bisher weiter in Spalte A geschrieben werden. Die Msg. Boxen würden dann natürlich entfallen.
Habe bisher im Forum leider nichts annäherndes gefunden.

Ich hoffe auf Eure Hilfe
Danke
flori006

7 Antworten

0 Punkte
Beantwortet von fedjo Experte (2.1k Punkte)
Hallo flori006,
Code in Tabelle1 einfügen. Du mußt natürlich noch dein Makro zu übertragen der Daten in Spalte A einbauen.

Option Explicit
Private Sub CommandButton1_Click()
If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter , Field:=1
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Range("A2:A" & Range("A65536").End(xlUp).Row)
With rngBer
strSuch = Range("D1").Value
If strSuch = "" Then
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
'Dein Makro einfügen um in Spalte A eintragen
Else
firstAddress = c.Address
Do
If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter , Field:=1
Range("A2").AutoFilter Field:=1, Criteria1:=Range("D1").Value, VisibleDropDown:=False
Loop While Not c Is Nothing And c.Address <> firstAddress
Range("D1") = ""
End If
End With
End Sub

Muster

Gruß
fedjo
0 Punkte
Beantwortet von flori006 Einsteiger (88 Punkte)
Hallo fedjo;

erst einmal Danke für die prompte Hilfe !

Mit dem Einfügen meines Speichermakros in Deinem Code habe ich wohl Probleme. Es sieht wie folgt aus:

Sub Kopieren1()
Application.ScreenUpdating = False
Sheets("WFF").Range("D1").Copy
Sheets("WFF").Cells(Sheets("WFF").Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row, 1).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
End Sub

Ich bekomme dann eine Fehlermeldung.
Das Arbeitsblatt habe ich natürlich umbenannt.
Könntest Du Dich noch einmal kümmern ?

Gruß
flori006
0 Punkte
Beantwortet von fedjo Experte (2.1k Punkte)
Hallo flori006,
habe dein Makro etwas verändert und mit eingefügt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Range("A2:A" & Range("A65536").End(xlUp).Row)
With rngBer
strSuch = Range("D1").Value
If strSuch = "" Then
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then

Dim Zfrei As Long
Zfrei = Sheets(1).Cells(65536, 1).End(xlUp).Row + 1
Sheets(1).Range("A" & Zfrei) = Sheets(1).Range("D1").Value
Range("D1") = ""
Else
firstAddress = c.Address
Do
If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter , Field:=1
Range("A2").AutoFilter Field:=1, Criteria1:=Range("D1").Value, VisibleDropDown:=False
Loop While Not c Is Nothing And c.Address <> firstAddress
Range("D1") = ""
End If
End With
End Sub

Muster

Gruß
fedjo
0 Punkte
Beantwortet von flori006 Einsteiger (88 Punkte)
Guten Tag fedjo;

besten Dank für die erneute Mühe.
Ich muß sagen so funktioniert es wie gewünscht.
Ich hatte noch weiter mit meinem Makro probiert, es funktionierte nur etwas umständlicher, ich mußte nach jeder Eingabe abspeichern und dann das Filtermakro anklicken.

Aber so ist es TOP !

Also Danke noch einmal

flori006
0 Punkte
Beantwortet von flori006 Einsteiger (88 Punkte)
Hallo fedjo;

bin noch mal da mit einem etwas anderem Anliegen.

Ich lege 12 Arbeitsblätter an. Bezeichnung : "LAFF-021"; "OZFF-023"; usw.
In Spalte A ab Zeile 4 mache ich Eingaben wie z.B. "DF7BCV"; "HA5XTI"; "GM0FPL" usw. fortlaufend nach unten.
Dieses geschieht auf allen 12 Arbeitsblättern in gleicher Art.
Hierbei können die gleichen Eingaben mehrfach auf jedem Arbeitsblatt erscheinen.

Nun möchte ich aber auf einem gesonderten Arbeitsblatt mit Bezeichnung "Auswahl" über ein Makro und der Eingabezelle B1
mir hier nachfolgend alle Einträge von allen 12 Arbeitsblättern mit nur jeweils einer gleichen Eingabe wie vor z.B. "DF7BCV"; oder Anderen, komplett mit der ganzen Zeile fortlaufend nach unten anzeigen lassen.

Ist es auch möglich das alle Eingaben von Buchstaben sofort in Großschrift gemacht werden können, ohne eine Zusatztaste zu betätigen ?

Wiederum herzlichen Dank
flori006
0 Punkte
Beantwortet von fedjo Experte (2.1k Punkte)
Hallo flori006,
dein neues Anliegen solltest du als Frage ins Forum stellen, damit dich auch andere User unterstützen können.

Gruß
fedjo
0 Punkte
Beantwortet von flori006 Einsteiger (88 Punkte)
Hallo fedjo;

Danke, habe Deinen Rat schon befolgt.
Mit der Großschrift bin ich schon weiter.

Beste Grüße
flori006
...