Zelleninhalt überprüfen und kopieren

Dieses Thema Zelleninhalt überprüfen und kopieren im Forum "Windows XP Forum" wurde erstellt von panscher, 11. Aug. 2006.

Thema: Zelleninhalt überprüfen und kopieren Hallo, ich habe mir einen kleine Kalender gebastelt und sitze jetzt vor dem Problem wie ich die Feiertag in meinen...

  1. Hallo,

    ich habe mir einen kleine Kalender gebastelt und sitze jetzt vor dem Problem
    wie ich die Feiertag in meinen Kalender eingetragen bekomme.


    Tabelle1

    A B
    1 15.04.2006 (hier soll später Ostersonntag stehen)
    2 16.04.2006 (hier soll später Ostermontag stehen)
    3 17.04.2006
    4 18.04.2006
    5 19.04.2006

    Tabelle Feiertage

    A B
    1 15.04.2006 Ostersonntag
    2 16.04.2006 Ostermontag
    3 17.04.2006
    4 18.04.2006
    5 19.04.2006

    Das Makro soll überprüfen welches Datum in Tabelle1 (A1-A5) steht und soll dann
    in Tabelle Feiertage nachsehen ob es einen passendenes Datum dazu gibt.
    Danach soll das Makro mir den Text, der hinter dem Datum im Tabelle Feiertage steht
    in Tabelle1 (B1-B4) einfügen.

    Gruß Martin
     
  2. Hallo Martin,

    das Makro FeiertagsbezeichnungenAusFeiertageEintragen sollte das Gewünschte machen.

    Gruß Matjes :)
    Code:
    Option Explicit
    
    Type MyFeiertage_struct
      sDate As String
      sBez  As String
    End Type
    
     ->Konstanten für Feiertagstabell
      Const cFT_BLTNAME = Feiertage ->Blattname
      Const cFT_SP_DATUM = 1           'Spalte A - Datum
      Const cFT_SP_BEZ = 2             'Spalte B - Feiertagsbezeichnung
      Const cFT_Z_ERSTEWERTEZEILE = 1 ->erste Zeile mit Werten
      
     ->Konstanten für Kalenderblatt
      Const cKB_SP_DATUM = 1           'Spalte A - Datum
      Const cKB_SP_BEZ = 2             'Spalte B - Feiertagsbezeichnung
      Const cKB_Z_ERSTEWERTEZEILE = 1 ->erste Zeile mit Werten
      
      Const cDATUMSFORMAT = dd.mm.yyyy->intern verwendetes Datumsformat
    
    '************************************************************************
    Sub FeiertagsbezeichnungenAusFeiertageEintragen()
     ->*** Makro überprüft alle Zellen der aktuellen Tabelle (Kalenderblatt) in der Spalte Datum,
     ->*** ob dieses Datum in der Tabelle Feiertage vorhanden ist.
     ->*** Wenn ja, wird die Feiertagsbezeichnung in das Kalennderblatt kopiert.
     ->***
    
      Dim wsKB As Worksheet, wb As Workbook
      Dim FT() As MyFeiertage_struct, FTCnt As Long
      Dim lKBRows As Long, dDate As Date, sDate As String, x As Long, y As Long
      
     ->aktive Mappe / aktives Blatt KB setzen
      Set wb = ActiveWorkbook
      Set wsKB = ActiveSheet
      
     ->Feiertagstabelle in Feld einlesen (Datum im Format dd.mm.yyyy)
      If Not FeiertagstabelleInFeldEinlesen(wb, FT(), FTCnt) Then GoTo AUFRAEUMEN
      
     ->Kalenderblatt-Datum auf Feiertag überprüfen
     ->ggf. Feiertagsbezeichnung eintragen
      lKBRows = wsKB.Cells(wsKB.Rows.Count, 1).End(xlUp).Row
      For x = cKB_Z_ERSTEWERTEZEILE To lKBRows
        If IsDate(wsKB.Cells(x, cKB_SP_DATUM).Value) Then
          dDate = wsKB.Cells(x, cKB_SP_DATUM).Value
          sDate = Format(dDate, cDATUMSFORMAT)
          For y = 1 To FTCnt
            If sDate = FT(y).sDate Then
              wsKB.Cells(x, cKB_SP_BEZ).Value = FT(y).sBez
              Exit For
            End If
          Next
        End If
      Next
      
    AUFRAEUMEN:
      Set wsKB = Nothing: Set wb = Nothing
    End Sub
    
    '************************************************************************
    Private Function FeiertagstabelleInFeldEinlesen(wb As Workbook, _
                                                    FT() As MyFeiertage_struct, FTCnt As Long) As Boolean
     ->Feiertagstabelle in Feld einlesen (Datum im Format dd.mm.yyyy)
      
      Dim wsFT As Worksheet
      Dim lFTRows As Long, x As Long, dDate As Date
      
      FeiertagstabelleInFeldEinlesen = False
      
      On Error Resume Next
      Set wsFT = ActiveWorkbook.Worksheets(cFT_BLTNAME)
      On Error GoTo 0
      Err.Clear
      If wsFT Is Nothing Then
        MsgBox Tabelle  & cFT_BLTNAME &  ist nicht in der aktiven Mappe vorhanden.
        GoTo AUFRAEUMEN
      End If
      FTCnt = 0: ReDim FT(1 To 1)
      lFTRows = wsFT.Cells(wsFT.Rows.Count, 1).End(xlUp).Row
      For x = cFT_Z_ERSTEWERTEZEILE To lFTRows
        If IsDate(wsFT.Cells(x, cFT_SP_DATUM).Value) Then
          FTCnt = FTCnt + 1: ReDim Preserve FT(1 To FTCnt)
          dDate = wsFT.Cells(x, cFT_SP_DATUM).Value
          FT(FTCnt).sDate = Format(dDate, cDATUMSFORMAT)
          FT(FTCnt).sBez = wsFT.Cells(x, cFT_SP_BEZ).Value
        End If
      Next
      
      FeiertagstabelleInFeldEinlesen = True
    AUFRAEUMEN:
      Set wsFT = Nothing
    End Function
     
Die Seite wird geladen...

Zelleninhalt überprüfen und kopieren - Ähnliche Themen

Forum Datum
Zelleninhalte automatisch verschieben Microsoft Office Suite 27. Feb. 2013
Zelleninhalt gleich Zelleninhalt Windows XP Forum 30. Jan. 2007
Anzahl Zelleninhalt Microsoft Office Suite 21. Dez. 2006
Zelleninhalt in jeweilige Zelle Kopieren Microsoft Office Suite 8. Nov. 2005
Re: Zelleninhalt merken und als Dateinamen verwenden ??? Microsoft Office Suite 4. Nov. 2005