Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Doppelklick zwei Bereiche ansprechen

Betrifft: Doppelklick zwei Bereiche ansprechen von: speednetz
Geschrieben am: 22.08.2020 18:45:12

Hallo!

Ich habe zwei 2.Problem:
Und hoffe das ihr mir helfen könnt.

Nachfolgendes Makro läuft so einband frei.

'

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [D11:D500]) Is Nothing Then Exit Sub
    If Cells(Target.Row, 7) = "" Then Exit Sub 'Kein Name -> Abbruch
                 With Worksheets("Stundenzettel")
                      .Range("H8") = Cells(Target.Row, 7).Text
                          Cancel = True
        Application.Goto .Range("H7")
            End With
End Sub

Hier mein 1. Problem
Es wird mit Doppelklick der Name in Stundenzettel H7 ein getragen.
Der Doppelklick wird in Übersichtstafel ausgeführt.
Nun möchte ich beim nächsten Doppelklick das H7 geprüft wird,
Wenn was drin steht soll der Eintrag dann in Zelle H29 eingetragen werde. Wenn Zelle auch einen Eintrag dann nächste Zellen prüfen und befüllen. Und so weiter.
Folgende Zelle sind noch vorhanden
H55 / H78 / H105/ H128/ H158/ H177/ H204/ H227
Ich hoffe ich habe mich einiger maßen verständlich ausgedrückt.
Der zweite Punkt ist das dieses Makro mit Doppelklick mit einem anderen Makro mit Doppelklick in der Tabelle Übersichtstafel laufen soll.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [F11:L500]) Is Nothing Then Exit Sub
    If Cells(Target.Row, 7) = "" Then Exit Sub 'Kein Name -> Abbruch
        With Worksheets("Rechnungsformular")
                .Range("C20") = Cells(Target.Row, 6).Text
        .Range("C21") = Cells(Target.Row, 7).Text
        .Range("C22") = Cells(Target.Row, 8).Text
        .Range("C24") = Cells(Target.Row, 9).Text
        .Range("C30") = Cells(Target.Row, 10).Text
        .Range("AQ38") = Cells(Target.Row, 12).Text
        .Range("AQ39") = Cells(Target.Row, 11).Text
                    Cancel = True
        Application.Goto .Range("C21")
        End With
    
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [D11:E500]) Is Nothing Then Exit Sub
    If Cells(Target.Row, 7) = "" Then Exit Sub 'Kein Name -> Abbruch
             
    With Worksheets("Stundenzettel")         
        .Range("H8") = Cells(Target.Row, 7).Text
                        Cancel = True
        Application.Goto .Range("H8")
            End With
End Sub

Hier meine Tabelle:

https://www.herber.de/bbs/user/139785.xlsm

Ich hoffe das es verständlich ist.
Wäre schön, wenn ihr mir hier bei helfen könntet.
Grüß Ralf

Betrifft: AW: Doppelklick zwei Bereiche ansprechen
von: Hajo_Zi
Geschrieben am: 22.08.2020 18:55:15

Hallo Ralf,

arbeite ohne Exit Sub.
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, [F11:L500]) Is Nothing Then
        If Cells(Target.Row, 7) <> "" Then
            With Worksheets("Rechnungsformular")
                .Range("C20") = Cells(Target.Row, 6).Text
                .Range("C21") = Cells(Target.Row, 7).Text
                .Range("C22") = Cells(Target.Row, 8).Text
                .Range("C24") = Cells(Target.Row, 9).Text
                .Range("C30") = Cells(Target.Row, 10).Text
                .Range("AQ38") = Cells(Target.Row, 12).Text
                .Range("AQ39") = Cells(Target.Row, 11).Text
                Cancel = True
                Application.Goto .Range("C21")
            End With
        End If
    Else
        If Not Intersect(Target, [D11:E500]) Is Nothing Then
            If Cells(Target.Row, 7) <> "" Then
                With Worksheets("Stundenzettel")
                    .Range("H8") = Cells(Target.Row, 7).Text
                    Cancel = True
                    Application.Goto .Range("H8")
                End With
            End If
        End If
    End If
End Sub
GrußformelHomepage

Betrifft: AW: Doppelklick zwei Bereiche ansprechen
von: speednetz
Geschrieben am: 22.08.2020 20:00:13

Hallo Hajo

Danke für deine schnelle Hilfe.

Ich habe es eingebaut und es läuft.

Kannst du mir bei der anderen Sache vielleicht auch noch helfen.
Das wäre sehr nett.

Gruß Ralf

Betrifft: AW: Doppelklick zwei Bereiche ansprechen
von: Hajo_Zi
Geschrieben am: 22.08.2020 20:26:41

Hallo Ralf,

andere Sache habe ich wohl überlesen im ersten Beitrag.

Gruß Hajo

Betrifft: AW: Doppelklick zwei Bereiche ansprechen
von: speednetz
Geschrieben am: 22.08.2020 20:58:33

Hallo Hajo

Wäre schön wenn du mir helfen konntest.

Vielleicht kann aber auch Jemand aus dem Form mir bei dieser Sache helfen.

Danke Schon mal Ralf

Betrifft: AW: Doppelklick zwei Bereiche ansprechen
von: Hajo_Zi
Geschrieben am: 22.08.2020 21:07:53

Hallo Ralf,

Gut Du möchtest mir nicht mitteilen wo das Problem ist.
Ich bin dann raus.
Viel Erfolg noch,

Gruß Hajo

Betrifft: Lesen bildet. o.w.T.
von: Werner
Geschrieben am: 22.08.2020 21:49:06



Betrifft: AW: Lesen bildet. o.w.T.
von: speednetz
Geschrieben am: 23.08.2020 10:51:42

Hallo Hajo

Tut mir leid das ich das Problem nicht noch mal beschrieben habe,da ich es ja schon bei der
ersten Anfrage mit beschrieben habe.

Gruß Ralf


Betrifft: AW: Lesen bildet. o.w.T.
von: Werner
Geschrieben am: 23.08.2020 11:07:26

Hallo,

1. Antwortest du mir und nicht Hajo.
2. Brauchst du dich bei dem nicht zu eintschuldigen, derartige Eskapaden sind bei ihm Standard.

Gruß Werner

Betrifft: AW: Lesen bildet. o.w.T.
von: speednetz
Geschrieben am: 23.08.2020 12:09:26

Hallo Werner

Hier noch mal meine Mappe

https://www.herber.de/bbs/user/139785.xlsm

Zu deiner Frage ja, wenn ich in zum Beispiel in D11 klicke dann steht in G11 dort der Name.

Also die vorgehen weise ist so gedacht.

Doppelklick in Übersichtstafel in Spalte D ( Kd. Nr. ) der Name aus
Spalte G der gleichen Zelle kopieren und in Stundenzettel in Zelle H7 einfügen. Wenn in H7 aber schon ein Name steht soll er den Namen in Zelle H29 eintragen. Wenn hier auch ein Name steht dann immer so weiter in die Folgenden Zelle die noch vorhanden sind
H55 / H78 / H105/ H128/ H158/ H177/ H204/ H227
Wenn H227 auch ein Name dann so wie bei dir

MsgBox "Fehler: Nichts mehr frei."

Ich hoffe ich habe es jetzt einiger maßen erklärt

Ich hoffe du kannst helfen.

Gruß Ralf

Betrifft: AW: Lesen bildet. o.w.T.
von: Werner
Geschrieben am: 23.08.2020 12:38:26

Hallo,

ich hab ja keine Ahnung was du gemacht hast, aber genau das macht das Makro doch.

https://www.herber.de/bbs/user/139794.xlsm

Was ich nicht verstehe: Warum Doppelklick in Spalte D und nicht direkt den Doppelklick auf den Namen in Spalte G auswerten.
Zudem hast du den Bereich für den Doppelklick auf Spalte D und E gelegt. Spalte E ist aber so klein gezogen, da kannst du doch gar nicht doppelt rein klicken.

Gruß Werner

Betrifft: AW: Lesen bildet. o.w.T.
von: speednetz
Geschrieben am: 23.08.2020 13:06:08

Hallo Werner

Ich habe dem Fehler gefunden.

Beim Kopieren habe ich die beiden Dim Anweisungen nicht mit kopiert.
Ich habe nun alles aus der zurück geschickten Mappe kopiert nun geht es.

Nun zu deiner Frage:

Denn Doppelklick mache ich deswegen in Spalte D weil Spalte G schon im oberen Bereich des Makros
verwende wird.

Bei der zweiten Sache habe ich mich nur verschrienen es ist Spalte D und nicht D und E.

Danke noch mal für deine Hilfe.

Gruß Ralf

Betrifft: Gerne u. Danke für die Rückmeldung. o.w.T.
von: Werner
Geschrieben am: 23.08.2020 14:21:33



Betrifft: vom ex MVP kommt nix mehr
von: Werner
Geschrieben am: 22.08.2020 21:52:52

Hallo,
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim raBereich As Range, raZelle As Range
Dim boEintrag As Boolean

Application.ScreenUpdating = False

If Not Intersect(Target, [F11:L500]) Is Nothing Then
    If Cells(Target.Row, 7) <> "" Then
        With Worksheets("Rechnungsformular")
            .Range("C20") = Cells(Target.Row, 6).Text
            .Range("C21") = Cells(Target.Row, 7).Text
            .Range("C22") = Cells(Target.Row, 8).Text
            .Range("C24") = Cells(Target.Row, 9).Text
            .Range("C30") = Cells(Target.Row, 10).Text
            .Range("AQ38") = Cells(Target.Row, 12).Text
            .Range("AQ39") = Cells(Target.Row, 11).Text
            Cancel = True
            Application.Goto .Range("C21")
        End With
    End If
Else
    If Not Intersect(Target, [D11:E500]) Is Nothing Then
        If Cells(Target.Row, 7) <> "" Then
            Cancel = True
            With Worksheets("Stundenzettel")
                Set raBereich = Union(.Range("H7"), .Range("H29"), .Range("H55"), _
                .Range("H78"), .Range("H105"), .Range("H128"), .Range("H158"), _
                .Range("H177"), .Range("H204"), .Range("H227"))
                For Each raZelle In raBereich
                    If raZelle = "" Then
                        raZelle = Cells(Target.Row, 7).Text
                        boEintrag = True
                        Application.Goto .Range("H8")
                        Exit For
                    End If
                Next raZelle
                If Not boEintrag Then
                    MsgBox "Fehler: Nichts mehr frei."
                End If
            End With
        End If
    End If
End If
End Sub
Gruß Werner

Betrifft: AW: vom ex MVP kommt nix mehr
von: speednetz
Geschrieben am: 23.08.2020 10:44:06

Hallo Werner

Danke schon mal für deine Hilfe.

Ich habe das geänderte Makro eingesetzt.

Es läuft zwar durch, aber es erfolgen keine Einträge in den
vor gegebenen Zellen.

Kannst du hier vielleicht noch mal nachschauen, wo dran das liegt.

Gruß Ralf

Betrifft: AW: vom ex MVP kommt nix mehr
von: Werner
Geschrieben am: 23.08.2020 11:05:39

Hallo,

bei mir schon. Und mehr kann ich dazu nicht sagen, weil ich deine Datei nicht kenne.
Lad doch mal deine Mappe hier hoch.

Frage: Du klickst doppelt in Zelle D11 - steht denn auch ein Wert in Zelle G11 ?

Gruß Werner

Beiträge aus dem Excel-Forum zum Thema "Doppelklick zwei Bereiche ansprechen"