Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Makro der Datum findet und Text einfügt
05.09.2017 09:18:08
Simon
Hallo liebe Leute!
Ich suche wieder folgende Lösung per Makro.
Ich habe im Excel ein kleine Eingabeformular erstellt mit "Datum, Schulung, Vortragender, Uhrzeit".
In einer anderen Arbeitstabelle habe ich einen Kalender vom ganzen Jahr aufgelistet wo Schulungen eingetragen werden.
Nun will ich wenn in meinem Eingabeformular alles ausgefüllt wurde, das ein Makro automatisch das eingetragene Datum sucht (z.B.: 09.01.2017 = Spalte A40) und die anderen Informationen direkt daneben in B40 einfügt.
Kann mir bei diesem Problem einer behilflich sein? Falls mein Text nicht verstanden wird einfach nachfragen ich antworte so schnell wie möglich!
Gruß Simon!

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro der Datum findet und Text einfügt
05.09.2017 10:07:53
UweD
Hallo
"Eingabeformular" wie sieht das aus?
Ist das eine Userform? oder einfach nur ein Eingabebereich in einer Tabelle?
Lad doch mal eine Musterdatei hoch.
LG UweD
AW: Makro der Datum findet und Text einfügt
05.09.2017 10:18:08
Simon
Das Eingabeformular ist einfach nur ein Eingabebereich in einer Tabelle.
Hier die hochgeladene Datei
https://www.herber.de/bbs/user/115987.xlsx
Gruß Simon
AW: Makro der Datum findet und Text einfügt
05.09.2017 11:20:10
UweD
Hallo
normal macht man das mit einer Userform.
aber geht auch so...
- Rechtsclick auf den Tabellenblattreiter der Tabelle "Formular"
- Code anzeigen
- Makro dort reinkopieren
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RNG As Range, TB, c As Range
    Dim Zeile As Double, Spalte As Integer
    
    On Error GoTo Fehler
    Set RNG = Union([H9], [H13], [H17], [H21])
    Set TB = Sheets("Übersicht")
    Spalte = 3 'Ziel-Spalte C 
    
    If Not Intersect(RNG, Target) Is Nothing Then 'nur wenn eine der 4 Zellen geändert wird 
    
        If IsDate([H9]) And [H13] <> "" And [H17] <> "" And [H21] <> "" Then ' nur, wenn alle belegt sind 
            
            Set c = TB.Columns(2).Find([H9], LookIn:=xlFormulas)
            If Not c Is Nothing Then
            
                TB.Cells(c.Row, Spalte) = [H13] & " (" & [H17] & ") " & [H21] & " Uhr"
                MsgBox "Erledigt"
            
            Else
                
                MsgBox "Datum nicht gefunden"
            
            End If
        End If
    End If
    
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub


Wie du die jeweils richtige Spalte auswählst, musst du da noch einbauen (Ich habe C als fix angesehen)
LG UweD
Anzeige
AW: Makro der Datum findet und Text einfügt
05.09.2017 11:38:46
Simon
Hallo!
Danke für deine schnelle Hilfe! Es funktioniert !!
Jedoch will ich das sich die Felder erst befüllen wenn ein Button betätigt wird.
Jetzt wird immer wenn ich ein Felder änder automatisch der Makro ausgeführt.
AW: Makro der Datum findet und Text einfügt
05.09.2017 11:59:36
UweD
Hallo nochmal
- dann lösche den code wieder.
- copiere das hier in ein normales Modul und weise das einem Button zu
Sub Starten()
    Dim TB1, TB2, c As Range
    Dim Zeile As Double, Spalte As Integer
    Dim Datum As Date, Schulung As String
    Dim Vortragender As String, Zeit As String
    
    On Error GoTo Fehler
    Set TB1 = Sheets("Formular")
    Set TB2 = Sheets("Übersicht")
    Spalte = 3 'Ziel-Spalte C 
    
    
    With TB1
        Datum = .Range("H9")
        Schulung = .Range("H13")
        Vortragender = .Range("H17")
        Zeit = .Range("H21")
    End With
    If IsDate(Datum) And Schulung <> "" And Vortragender <> "" And Zeit <> "" Then ' nur, wenn alle belegt sind 
        
        Set c = TB2.Columns(2).Find(Datum, LookIn:=xlFormulas)
        If Not c Is Nothing Then
            
            TB2.Cells(c.Row, Spalte) = Schulung & " (" & Vortragender & ") " & Zeit & " Uhr"
            MsgBox "Erledigt"
            
        Else
                
            MsgBox "Datum nicht gefunden"
            
        End If
    Else
        
        MsgBox "Eingabe unvollständig"
        
    End If
    

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Makro der Datum findet und Text einfügt
05.09.2017 13:26:03
Simon
RESPEKT Es funktioniert einwandfrei.
Es tut mir leid das ich wieder etwas vergessen habe, aber ich habe in der Musterdatei unter Uhrzeit eine Eingabe vergessen.
Diese heißt Reserviert.
Dieser Punkt wird nur bei manchen Schulungen benötigt.
Das heißt bei Sonderschulungen soll hinter dem Schulungsnamen die Kurzbezeichnung "res." stehen und alles was in der Tabelle über das Formular eingetragen wird, soll Kursiv dargestellt werden. Ich hoffe ich konnte mich deutlich ausdrücken falls nicht einfach nachfragen.
Ich Entschuldige und bedanke mich schon mal für den Aufwand!
Gruß Simon
Anzeige
AW: Makro der Datum findet und Text einfügt
05.09.2017 13:53:02
UweD
Also egal was dann da drin steht, es soll dann immer " res. " angehangen werden...
Sub Starten()
    Dim TB1, TB2, c As Range
    Dim Zeile As Double, Spalte As Integer
    Dim Datum As Date, Schulung As String
    Dim Vortragender As String, Zeit As String
    Dim Reservierung As String
    
    On Error GoTo Fehler
    Set TB1 = Sheets("Formular")
    Set TB2 = Sheets("Übersicht")
    Spalte = 3 'Ziel-Spalte C 
    
    
    With TB1
        Datum = .Range("H9")
        Schulung = .Range("H13")
        Vortragender = .Range("H17")
        Zeit = .Range("H21")
        Reservierung = .Range("H25")
    End With
    If IsDate(Datum) And Schulung <> "" And Vortragender <> "" And Zeit <> "" Then ' nur, wenn alle belegt sind 
        Reservierung = IIf(Reservierung <> "", " res. ", "")
        
        Set c = TB2.Columns(2).Find(Datum, LookIn:=xlFormulas)
        If Not c Is Nothing Then
            
            With TB2.Cells(c.Row, Spalte)
                .Value = Schulung & Reservierung & " (" & Vortragender & ") " & Zeit & " Uhr"
                
                If Reservierung <> "" Then
                    .Font.Italic = True
                Else
                    .Font.Italic = False
                End If
                
            End With
            MsgBox "Erledigt"
            
        Else
                
            MsgBox "Datum nicht gefunden"
            
        End If
    Else
        
        MsgBox "Eingabe unvollständig"
        
    End If
    

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

oder soll das angehangen werden, was drin steht?
dann diese Zeile so.
        Reservierung = IIf(Reservierung  "", " " & Reservierung, "")

LG UweD
Anzeige
AW: Makro der Datum findet und Text einfügt
05.09.2017 14:31:45
Simon
Hat funktioniert!
Perfekt umgesetzt.
Besten Dank für deine Hilfe!
Gruß Simon
Danke für die Rückmeldung owT
05.09.2017 14:46:00
UweD
AW: Danke für die Rückmeldung owT
05.09.2017 15:15:45
Simon
So nurnoch eine kleine Änderung tut mir leid, ich muss ein kleines Projekt für meinen Arbeitgeber machen. Gibt es auch noch eine Möglichkeit, nehmen wir an unter dem Feld Reserviert ist noch ein Feld mit Besonderheiten. Und wenn in dem Feld Besonderheiten etwas eingetragen ist (z.B.: Wir benötigen noch neue Schulungsbenutzer) das der Text im gesamten Feld mit rot markiert wird und ein kleines Notizfenster mit dem jeweiligen Text steht? Dieses Notizfenster soll vielleicht nur aufpoppen wenn man mit dem Cursor auf den roten Text klickt.
Wenn es nicht möglich ist ist das auch kein Problem!
DANKE VIELMALS
Anzeige
AW: Danke für die Rückmeldung owT
05.09.2017 15:52:54
UweD
Hallo nochmal
natürlich ist das möglich
Sub Starten()
    Dim TB1, TB2, c As Range
    Dim Zeile As Double, Spalte As Integer
    Dim Datum As Date, Schulung As String
    Dim Vortragender As String, Zeit As String
    Dim Reservierung As String, Besonderheiten As String
    
    On Error GoTo Fehler
    Set TB1 = Sheets("Formular")
    Set TB2 = Sheets("Übersicht")
    Spalte = 3 'Ziel-Spalte C 
    
    
    With TB1
        Datum = .Range("H9")
        Schulung = .Range("H13")
        Vortragender = .Range("H17")
        Zeit = .Range("H21")
        Reservierung = .Range("H25")
        Besonderheiten = .Range("H29")
    End With
    If IsDate(Datum) And Schulung <> "" And Vortragender <> "" And Zeit <> "" Then ' nur, wenn alle belegt sind 
        Reservierung = IIf(Reservierung <> "", " res.", "")
        
        Set c = TB2.Columns(2).Find(Datum, LookIn:=xlFormulas)
        If Not c Is Nothing Then
            
            With TB2.Cells(c.Row, Spalte)
                .Value = Schulung & Reservierung & " (" & Vortragender & ") " & Zeit & " Uhr"
                
                If Reservierung <> "" Then
                    .Font.Italic = True
                Else
                    .Font.Italic = False
                End If
                
                If Besonderheiten <> "" Then
                    .Font.ColorIndex = 3 'rot 
                    
                    .ClearComments
                    .AddComment
                    .Comment.Visible = False
                    .Comment.Text Text:=Besonderheiten
                Else
                    .Font.Italic = xlAutomatic
                
                    .ClearComments
                End If
                
            End With
            MsgBox "Erledigt"
            
        Else
            MsgBox "Datum nicht gefunden"
        End If
    Else
        MsgBox "Eingabe unvollständig"
    End If

    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Danke für die Rückmeldung owT
05.09.2017 16:25:01
UweD
upps da ist noch was falsch
                    .Font.Italic = xlAutomatic
muss sein
                    .Font.ColorIndex= xlAutomatic
LG
AW: Danke für die Rückmeldung owT
05.09.2017 18:29:42
Simon
Jetzt funktioniert der VBA-Code perfekt!
Unglaublich was du in kurzer Zeit machen kannst.
RESPEKT an dich und nochmals VIELEN DANK!
AW: Danke für die Rückmeldung owT
06.09.2017 08:54:25
Simon
Ok das einzige das mir vor dem letzten Test noch aufgefallen ist, ist das sich das Kommentar nicht löscht wenn noch Text in der Übersichtstabelle eingetragen ist. Kann man das vielleicht noch korrigieren?
AW: Danke für die Rückmeldung owT
06.09.2017 09:38:19
UweD
Hallo
Verstehe ich nicht.
Was soll wann geschehen und was war vorher?
Userbild
Userbild
so sieht das bei mir aus
LG UweD
Anzeige
AW: Danke für die Rückmeldung owT
06.09.2017 09:50:40
Simon
Falls der Termin bei "DI, 05. September 2017" gelöscht wird soll das Kommentar ebenso verschwinden. Falls dies nicht möglich ist, ist das kein Problem!
Ich hoffe ich konnte mich jetzt besser ausdrücken
Gruß Simon
AW: Danke für die Rückmeldung owT
06.09.2017 11:07:41
UweD
Hallo
das ginge so...
- Rechtsclick auf den Tabellenblattreiter "Übersicht"
- Code anzeigen
- Diesen Code dort reinkopieren
Wenn sich jetzt der Wert in den Spalten C bis H "auf NICHTS" ändert, dann wird auch der Kommentar rausgenommen.
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim z
    If Target.Row < 4 Then Exit Sub
    If Not Intersect(Range("C:H"), Target) Is Nothing Then
        If Target = "" Then Target.ClearComments
    End If

End Sub

LG UweD
Anzeige
AW: Danke für die Rückmeldung owT
06.09.2017 11:25:26
Simon
PERFEKT!
Danke nochmal für deine Hilfe und Geduld.
Jetzt habe ich WIRKLICH alles was ich benötige.
Prima! Danke für die Rückmeldung. owT
06.09.2017 13:53:51
UweD

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige