Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
784to788
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
784to788
784to788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA-Codeanpassung, die 2. (evtl. @Sepp)

VBA-Codeanpassung, die 2. (evtl. @Sepp)
28.07.2006 19:36:54
Dirk
Hallo an Alle,
wie so oft, treten die meisten Fragen u. Probleme erst im Praxistest auf.
Zur u.g. Thematik daher folgende Fragen:
1. Warum wird beim Löschen des doppelten Eintrags (speziell meine ich NUR das LÖSCHEN, außer natürl. der Änderung) nicht der entspr. Eintrag in 'doppelte TS' entfernt ?
2. Warum erfolgt dieses Entfernen auch nicht, wenn der "Ersteintrag" gelöscht wird ?
3. u. eigentliches Hauptproblem: Nach dem Speichern u. Schliessen der Datei mit mehr als einem Doppeleintrag (man kann ja auch mal etwas Arbeit für den nächsten Tag aufheben ;-)), erfolgt zwar beim Öffnen dann der Hinweis auf doppelte Einträge - doch nach der Korrektur zieht dann das Chaos ein im Blatt 'doppelte TS'. Leider lässt sich dieses Chaos schwer beschreiben - daher bitte mal testen. In Spalte G habe ich eine lfd. Nummer nur zu Testzwecken eingefügt, was einem "NICHT-DAU" vielleicht hilft, den Fehler im Code zu erkennen...
Bin für jede Hilfe u. Anregung dankbar !
MfG Dirk N.
P.S.: Leider kriege ich das mit einem Link zu dem "Ursprungs-" Thread nicht hin aber in der Recherche einfach DRINDEND (kleiner, aber nun hilfreicher Rechtschreibfehler ;-)) eingeben et voilà...
Trotzdem hier noch die Beispielmappe:
https://www.herber.de/bbs/user/35428.xls

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Codeanpassung, die 2. (evtl. @Sepp)
28.07.2006 21:23:08
Josef
Hallo Dirk!
Das entfernen beim Löschen geht mit diesem angepassten Code.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim lrow As Long
Dim lcol As Long
Dim Wks As Worksheet
Dim blnDouble As Boolean
Dim rng As Range

lrow = Target.Row
lcol = Target.Column

On Error GoTo ErrExit

If (Left(Sh.Name, 2) = "MA" And InStr(1, Sh.Name, "-") > 0) Or Left(Sh.Name, 2) <> "MA" Then Exit Sub
If Intersect(Target, Range("b26:h31")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

Application.EnableEvents = False

For Each Wks In ThisWorkbook.Worksheets
  If Not Wks Is Sh Then
    If Left(Wks.Name, 2) = "MA" And InStr(1, Wks.Name, "-") = 0 Then
      If Target <> "" Then
        If Target = Wks.Cells(lrow, lcol) Then
          blnDouble = True
          With Worksheets("doppelte TS").Cells(100, 1).End(xlUp)
            .Offset(1, 0) = Wks.Name
            .Offset(1, 0).Hyperlinks.Add Anchor:=.Offset(1, 0), _
              Address:="", _
              SubAddress:="'" & Wks.Name & "'!" & Target.Address
            .Offset(1, 1) = Target.Address
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Target.Worksheet.Name
            .Offset(1, 3).Hyperlinks.Add Anchor:=.Offset(1, 3), _
              Address:="", _
              SubAddress:="'" & Target.Worksheet.Name & "'!" & Target.Address
            .Offset(1, 4) = Target.Address
            Set rng = .Offset(1, 0)
          End With
        End If
      End If
    End If
  End If
Next
resetTable
ErrExit:
Application.EnableEvents = True

If blnDouble Then
  MsgBox "Dieser Tätigkeitsschlüssel existiert bereits" & vbLf & _
    "Genaue Angaben dazu stehen in 'doppelte TS'", vbInformation, "Hinweis"
  Application.Goto rng
End If

End Sub



Welche Chaos du allerdings meinst, kann ich nicht nachvollziehen.
Gruß Sepp

Anzeige
AW: VBA-Codeanpassung, die 2. (evtl. @Sepp)
28.07.2006 22:41:03
Dirk
Hallo Sepp,
danke für deine schnelle Antwort - funktioniert tadellos !!!
Mit "Chaos" meinte ich folgende Veränderung in 'doppelte TS':
Nach der unter Punkt 3 beschriebenen Prozedur, also NACH der Korrektur der doppelten Einträge in nicht chronologischer Folge, wurde auch die 2. ZEILE in diesem Blatt gelöscht. Diese wurde dann bei der nächsten Doppelung auch wieder "befüllt", jedoch bei nachfolgenden Änderungen außer Betracht gelassen (lt. Bereichsdef.: A3:A natürlich folgerichtig). Man mußte den Eintrag in dieser Zeile dann manuell entfernen, in Zelle A2 irgendetwas eintragen u. es funzte dann wieder solange, bis der genannte Sonderfall (Schließen VOR Korrektur) wieder auftrat. Dann begann das Spiel von vorn...
Auch mit deinem neuesten Code passierte dies (an der Löschroutine wurde ja auch nichts geändert) - allerdings nur EINMAL.
Ist schon irgendwie kurios, aber bei ca. 15 weiteren Tests funktionierte alles bestens !!!
Aber vielleicht verwechselt mein PC ab u. an mal "1" u. "0" ;-) (Anmerkung von einem DAU ;-)) !
Vielen Dank für deine Hilfe - nun gehe ich zufrieden ins WE u. wünsche dir u. allen Anderen hier alles Gute!
MfG Dirk N.
Anzeige
AW: VBA-Codeanpassung, die 2. (evtl. @Sepp)
28.07.2006 23:19:03
fcs
Hallo Dirk,
das Chaos ist bei mir auch passiert. Mit folgenden Anpassungen an der Reset-Routine sollte das auch bereinigt sein. Zusätlich wird eine Zeile auch gelöscht, wenn beide Zielzellen leer sind.
gruss Franz

Private Sub resetTable()
Dim rng As Range, rngDel As Range
On Error Resume Next
With Sheets("doppelte TS")
If .Cells(.Rows.Count, 1).End(xlUp).Row = 2 Then Exit Sub 'keine Einträge in der Tabelle '=== geändert fcs
For Each rng In .Range("A3:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If Sheets(rng.Text).Range(rng.Offset(0, 1).Text) <> Sheets(rng.Offset(0, 3).Text).Range(rng.Offset(0, 4).Text) Or _
(Sheets(rng.Text).Range(rng.Offset(0, 1).Text) = "" And _
Sheets(rng.Offset(0, 3).Text).Range(rng.Offset(0, 4).Text) = "") Then '=== geändert fcs
If rngDel Is Nothing Then
Set rngDel = rng.EntireRow
Else
Set rngDel = Union(rngDel, rng.EntireRow)
End If
End If
Next
End With
If Not rngDel Is Nothing Then rngDel.Delete
On Error GoTo 0
End Sub

Anzeige
AW: VBA-Codeanpassung, die 2. (evtl. @Sepp)
29.07.2006 00:26:49
Dirk
Hallo Franz,
gerade saß ich noch an der nä. Monatsplanung u. der Fehler trat wieder auf...
Nach endlosem Experimentieren kam ich dann dahinter, wann genau der Fehler auftritt u. wollte dies posten.
Doch dann (leider erst dann) sah ich deine Antwort u. es ist GENAU die Lösung !!!
Dank euch Beiden ist es jetzt wohl PERFEKT - ihr seid ein gutes Beispiel dafür, wie produktiv Teamwork auf höchster Ebene ist.
VIELEN DANK u. Grüße ins Salzkammergut.
MfG Dirk N.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige