Makro der Datum findet und Text einfügt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

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

Beliebteste Forumthreads (12 Monate)

Makro der Datum findet und Text einfügt

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro der Datum findet und Text einfügt

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

313 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread