Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
728to732
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Arbeitsblatt umbenennen

Arbeitsblatt umbenennen
04.02.2006 13:45:13
Paul
Hallo Forum,
durch eure Hilfe hier habe ich meine Vorstellungen fast erreicht, jedoch habe ich Probleme, da der Code irgendwo ein Problem hat.
Meine Tabelle geht über mehrere Blätter und enthält die verschiedensten Formeln.
Wenn ich nun in der Spalte H meine Werte eingeben möchte geht dies in einer Test-Tabelle einwandfrei. Wenn ich den Code dann in meine Originaltabelle einfüge gibt es Probleme. Wenn ich einen Wert löschen möchte kommt die Auswahlbox mehrmals wieder. Per Nein komm ich gar nicht mehr raus, aber mit 4-maligem Ja komme ich aus der Auswahlbox wieder raus.
Der Code soll folgendes machen:
Wenn ich in Zelle N1 einen Wert eingebe, soll das Arbeitsblatt anhand dieses Wertes umbenannt werden.
Desweiteren:
Ich gebe Werte in Spalte H ein und der Code soll überwachen, dass eben dieser Wert in den anderen Blättern in Spalte H nicht vorkommt. Befindet sich dieser Wert schon in einem Arbeitsblatt in Spalte H soll der Hinweis erfolgen: "Achtung bereits in Tabelle"X" enthalten, wollen Sie dies zulassen?"
VBA-Code in jedem Arbeitsblatt:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address(0, 0) = "N1" Then
ActiveSheet.Name = Target.Text
ElseIf Target.Column = 8 Then
Call Doppelte_suchen(Target.Row, Target.Column)
End If
End Sub

VBA-Code in Modul:
Sub Doppelte_suchen(z As Integer, s As Integer)
Dim ws As Worksheet, wsNameA As String
Dim Lz As Integer, i As Integer
Dim Eingabe As String, Aktiv As Object
Dim Weiter
Set Aktiv = ThisWorkbook.ActiveSheet
wsNameA = ThisWorkbook.ActiveSheet.Name
Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s)
For Each ws In ActiveWorkbook.Worksheets
Lz = ws.Cells(Rows.Count, 8).End(xlUp).Row
For i = 1 To Lz
If Eingabe "" Then
If ws.Cells(i, 8) = Eingabe Then
If ws.Name wsNameA Then
Weiter = MsgBox("Achtung, Eintrag bereits in " & ws.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 8) = ""
Aktiv.Cells(z, 8).Select
Exit Sub
End If
End If
End If
End If
Next i
Next ws
Lz = Aktiv.Cells(Rows.Count, 8).End(xlUp).Row
For i = 1 To Lz - 1
If Aktiv.Cells(i, 8) = Eingabe Then
Weiter = MsgBox("Achtung, Eintrag bereits in " & ActiveSheet.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 8) = ""
Aktiv.Cells(z, 8).Select
Exit Sub
End If
End If
Next i
End Sub
Bin für jeden Hinweis dankbar
Gruß Paul

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblatt umbenennen
05.02.2006 00:32:39
Daniel
Hallo Paul
Das Problem wird sein, das in der Originaldatei in den verschiedenen Spalten H Leerzellen INNEERHALB der Daten vorhanden sind. Beim Löschen hast du ja ein Leerfeld, das dann mit diesen übereinstimmt und die entsprechende Meldung erzeugt.
Daher würde ich in das erste Makro eine Abfrage einbauen, die sicherstellt, daß das zweite Makro nur aufgerufen wird, wenn auch tatsächlich Text eingegeben wurde.
:
-------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
ElseIf Target.Column = 8 AND Target.Value <> "" Then
Call Doppelte_suchen(Target.Row, Target.Column)
End If
End Sub

----------------------------------------------------------
Noch ein paar Hinweise:
1. Warum setzt du die Stopp-Funktion bei Fehlern ausser Kraft?
Wenn das Makro bei Fehlern anhält, kannst du die Ursache viel leichter lokalisieren
2. Die Reihenfolge der IF-Abfragen im 2. Makro ist ungünstig.
Die Abfrage auf das Worksheet "If ws.Name wsNameA Then" kann direkt nach nach dem Start der For Each ws In ActiveWorkbook.Worksheets-Schleife erfolgen.
3. Die Überprüfung jedes einzelnen Wertes mit einer Schleife ist sehr zeitaufwendig und läßt sich wesentlich eleganter mit der FIND-Methode lösen:
Statt:
----------------------
For i = 1 To Lz
If Eingabe "" Then
If ws.Cells(i, 8) = Eingabe Then
...
Next
--------------------------------
Schreibst du
lz = 0
on error resume next
lz = WS.columns(8).find(what:=Eingabe, lookat:=xlwhole).row
on error goto 0
if lz > 0 then ....
Bei dieser Methode verwendest du keine Schleife sondern die FIND-Methode von Excel.
Wenn dein Eingabewert in der Spalte H des durchsuchten Worksheets vorhanden ist, wird die Zeilennummer in der der gefundene Wert steht an die Variable lz übergeben.
Wird der Wert nicht gefunden, bleibt der der Wert von lz bei 0.
An dieser Stelle ist die Verwendung von "on error resume next" erforderlich, da sonst das Makro anhalten würde, wenn der Wert nicht gefunden wird (ist aber an dieser Stelle ja kein Fehler). Danach schalte ich die Stopp-Funktion aber schnellstmöglich mit "on error goto 0" wieder ein.
Gruß, Daniel Eisert
Anzeige
AW: Arbeitsblatt umbenennen
05.02.2006 12:27:08
Paul
Hallo Daniel,
ich steh etwas auf dem Schlauch (hab nahezu keine VBA-Kenntnisse).
Deine Hinweise hab ich versucht einzubauen, aber irgendwie klappt es bei mir nicht.
Mir ist noch etwas ausgefallen: Wenn ich einige Einträge löschen möchte kommt der die Hinweis-Box ebenfalls (springt der Code an, weil ich leere Zellen "erzeuge/eingebe" ?)
Dies wäre eigentlich nicht notwendig.
Wäre es evtl. einfacher den zu durchsuchenden Bereich zu beschränken ? Anstelle der kompletten Spalte H nur den Bereich H6:H32 ?
Wer weiß noch Hilfe ?
Gruß Paul
AW: Arbeitsblatt umbenennen
05.02.2006 13:10:23
Paul
Hallo Daniel,
ich habe mich nochmal dran versucht und soweit funktioniert es jetzt eigentlich auch. Lediglich wenn ich mehrere Zellen markiere und diese löschen möchte, stellt der Code fest dass dieselben Einträge bereits im ersten Arbeitsblatt enthalten ist. Wenn ich einzelne Zellen lösche verhält sich der Code ruhig. Liese sich hierfür noch etwas einbauen ?
Inzwischen sieht mein Code wie folgt aus:
In jedem Arbeitsblatt:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address(0, 0) = "N1" Then
ActiveSheet.Name = Target.Text
ElseIf Target.Column = 8 And Target.Value <> "" Then
Call Doppelte_suchen(Target.Row, Target.Column)
End If
End Sub

In Modul:
Sub Doppelte_suchen(z As Integer, s As Integer)
Dim ws As Worksheet, wsNameA As String
Dim Lz As Integer, i As Integer
Dim Eingabe As String, Aktiv As Object
Dim Weiter
Set Aktiv = ThisWorkbook.ActiveSheet
wsNameA = ThisWorkbook.ActiveSheet.Name
Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s)
For Each ws In ActiveWorkbook.Worksheets
Lz = ws.Cells(Rows.Count, 8).End(xlUp).Row
Lz = 0
On Error Resume Next
Lz = ws.Columns(8).Find(what:=Eingabe, lookat:=xlWhole).Row
On Error GoTo 0
If Lz > 0 Then
If ws.Name wsNameA Then
Weiter = MsgBox("Achtung, Eintrag war bereits in " & ws.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 8) = ""
Aktiv.Cells(z, 8).Select
Exit Sub
End If
End If
End If
Next ws
Lz = Aktiv.Cells(Rows.Count, 8).End(xlUp).Row
For i = 1 To Lz - 1
If Aktiv.Cells(i, 8) = Eingabe Then
Weiter = MsgBox("Achtung, Eintrag bereits in " & ActiveSheet.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 8) = ""
Aktiv.Cells(z, 8).Select
Exit Sub
End If
End If
Next i
End Sub
Gibt es evtl. Möglichkeiten zur Vereinfachung bzw. zur Optimierung ?
Bin für jeden Hinweis dankbar
Gruß Paul
Anzeige
AW: Arbeitsblatt umbenennen
06.02.2006 00:06:47
Daniel
Hallo,
Sorry, habe ich nicht bedacht, bei Mehrfachselektion funktioniert Target.Value nicht.
Ersetze im ersten Makro
. ElseIf Target.Column = 8 And Target.Value "" Then
durch
. ElseIf Target.Column = 8 And Target(1).Value "" Then
Dann sollte es gehen.
Noch eine Optimierung, die mir gerade eingefallen ist:
ersezte:
. On Error Resume Next
. Lz = ws.Columns(8).Find(what:=Eingabe, lookat:=xlWhole).Row
. On Error GoTo 0
Durch: Lz = Application.WorksheetFunction.CountIf(ws.columns(8),Eingabe)
Dadurch wird die Eingabe nicht mehr gesucht, sondern es wird wie mit ZählenWenn-Funktion gezählt, wie oft die Eingabe in der entsprechenden Spalte vorhanden ist.
Insgesamt etwas optimiert sieht der vollständige Code fürs 2. Makro so aus:
--------------------------------------------------------------

Sub Doppelte_suchen(z As Integer, s As Integer)
Dim ws, Aktiv As Worksheet
Dim Lz As Integer
Dim Eingabe As String
Dim Weiter
Set Aktiv = ThisWorkbook.ActiveSheet
Eingabe = ThisWorkbook.ActiveSheet.Cells(z, s)
For Each ws In ActiveWorkbook.Worksheets
Lz = Application.WorksheetFunction.CountIf(ws.columns(s),Eingabe)
If ws.name = Aktiv.name then Lz = Lz - 1 'im aktven Sheet darf der Text ja einmal vorkommen
If Lz > 0 Then
Weiter = MsgBox("Achtung, Eintrag war bereits in " & ws.Name & _
" vorhanden. Wollen Sie dies zulassen?", vbYesNo)
If Weiter = vbNo Then
Aktiv.Cells(z, 8).value = ""
exit for 'Schleifenabbruch, wenn der wert gelöscht wurde, (kein weiters Suchen erforderlich)
End If
End If
Next ws
End Sub

-----------------------------------------------------------
Außderdem wird jetzt das Aktive Sheet auch durchsucht, dh. eine Doppeleingabe wird auf jeden Fall vermieden.
Nochmal: schmeiß den "On Error Resume Next" im ersten Makro raus!
Fehler dürfen nicht vertuscht sondern müssen erkannt und behoben werden.
Sonst bekommst du seltsame Ergebnisse und wirst nie den Grund dafür finden.
Gruß, Daniel Eisert
Anzeige
Danke
06.02.2006 21:56:15
Paul
Hallo Daniel,
absolut spitze, deine Hilfe.
Der Code funktioniert einwandfrei. Ich habe jetzt nichts mehr dran auszusetzen.
Ich hab all deine Tipps befolgt. Jetzt ist der Code auch viel übersichtlicher (nur noch halb so lang)
Nochmals besten Dank für deine Hilfe
Gruß Paul
falscher Titel; korrekt :Doppelte Einträge finden
05.02.2006 19:34:31
Paul
Hallo Forum,
der Titel des Themas ist nicht ganz korrekt.
Eigentlich handelt es sich hier um das Thema doppelte Einträge finden und ggf. verhindern

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige