Microsoft Excel

Herbers Excel/VBA-Archiv

Zellenübertrag mit festen Regeln | Herbers Excel-Forum


Betrifft: Zellenübertrag mit festen Regeln von: Ralf
Geschrieben am: 22.02.2010 10:27:25

Hallo Forum,

ich möchte für ein Projekt Arbeitszeiten erfassen.
Dies soll per Knopfdruck geschehen.
In folgender Datei habe ich dies einmal als Beispiel dargestellt:

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

Jetzt sollen die Zeiten aus der "Temp" Spalte in die Zellen des entsprechenden Datums übertragen werden.
Wer kann mir dabei helfen, dies per Makro zu realisieren?

Vielen Dank schon mal im Voraus.

Viele Grüße

Ralf

  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Tino
Geschrieben am: 22.02.2010 17:13:50

Hallo,
kannst ja mal testen.

Sub test_uhrzeit_einfügen()
Dim meArTemp(), meArTabelle(), MeARDatum()
Dim A As Long
Dim vCol

With Tabelle1 'Tabelle anpassen 
    If .Cells(Rows.Count, 1).End(xlUp).Row < 10 Then Exit Sub
    
    meArTemp = Range("A10", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 2).Value2
    Redim Preserve meArTemp(1 To Ubound(meArTemp), 1 To 1)
    MeARDatum = Range("B9:AF9").Value2
    Redim meArTabelle(1 To Ubound(meArTemp), 1 To Ubound(MeARDatum, 2))
    
    For A = 1 To Ubound(meArTemp)
        If IsNumeric(meArTemp(A, 1)) Then
            vCol = Application.Match(Fix(meArTemp(A, 1)), MeARDatum, 0)
            If IsNumeric(vCol) Then
                meArTabelle(A, vCol) = meArTemp(A, 1) - Fix(meArTemp(A, 1))
            End If
        End If
    Next A
    
    With .Range("B10").Resize(Ubound(meArTabelle), Ubound(meArTabelle, 2))
        .Value = meArTabelle
        .NumberFormat = "h:mm:ss"
        .EntireColumn.AutoFit
    End With

End With


End Sub
Gruß Tino


  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Ralf
Geschrieben am: 23.02.2010 05:59:49

Hallo Tino,

das sieht schon mal sehr gut aus.
2 Punkte habe ich jetzt noch:
1. Die "übertragenen" Zeiten aus der Temp Spalte werden in der gleichen Zeile der echten Tabelle eingefügt. Kann man das Makro so umschreiben, dass für jeden Tag die erste Zeit in Zeile 10 steht?
2. Ich habe logischerweise 12 Tabellenblätter für jeden Monat (Jan, Feb, Mar, Apr, ...) mit einem Tabellenblatt "Temp". Die Uhrzeiten möchte ich im Temp Tabellenblatt schreiben ab Zelle Q6 abwärts. Kannst Du das so anpassen, dass die Uhrzeiten alle in das Temp geschrieben werden und die Monatsauswertungen hieraus befüllt wird wird (mit der Voraussetzung aus Punkt 1).

Vielen Dank schon einmal für Deine Hilfe.

Gruß

Ralf


  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Tino
Geschrieben am: 23.02.2010 16:05:18

Hallo,
hier die Tabellen Jan bis Dez.
Die Daten werden von oben nach unten einsortiert.

Sub test_uhrzeit_einfügen()
Dim meArTemp(), meArTabelle(), MeARDatum()
Dim A As Long, NextRow As Long
Dim vCol
Dim ArTab, iSH As Integer

'hier die Tabellen anpassen 
ArTab = Array("Jan", "Feb", "Mrz", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")

For iSH = Lbound(ArTab) To Ubound(ArTab)
    With Sheets(ArTab(iSH))
        If .Cells(Rows.Count, 1).End(xlUp).Row < 10 Then Exit Sub
        
        meArTemp = .Range("A10", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value2
        Redim Preserve meArTemp(1 To Ubound(meArTemp), 1 To 1)
        MeARDatum = Range("B9:AF9").Value2
        Redim meArTabelle(1 To Ubound(meArTemp) + 1, 1 To Ubound(MeARDatum, 2))
        
        For A = 1 To Ubound(meArTemp)
            If IsNumeric(meArTemp(A, 1)) Then
                vCol = Application.Match(Fix(meArTemp(A, 1)), MeARDatum, 0)
                If IsNumeric(vCol) Then
                    NextRow = meArTabelle(Ubound(meArTabelle), vCol) + 1
                    meArTabelle(Ubound(meArTabelle), vCol) = NextRow
                    meArTabelle(NextRow, vCol) = meArTemp(A, 1) - Fix(meArTemp(A, 1))
                End If
            End If
        Next A
    
        With .Range("B10").Resize(Ubound(meArTabelle) - 1, Ubound(meArTabelle, 2))
            .Value = meArTabelle
            .NumberFormat = "h:mm:ss"
            .EntireColumn.AutoFit
        End With
    
    End With
Next iSH

End Sub

Deinen Punkt 2 verstehe ich nicht,
die Daten die man oben einsortiert wieder in einer anderen Tabellen ausgeben?

Gruß Tino


  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Ralf
Geschrieben am: 23.02.2010 20:13:21

Hallo Tino,

erstmal vielen dank für Deine Mühen.
Ich werde das morgen früh am Schreibtisch ausprobieren.
zu Punkt 2: Ich möchte die gestempelten Zeiten in ein Tabellenblatt "Temp" schreiben (Q6,Q7,Q8, usw.). Aus diesem Tabellenblatt "Temp" sollen dann die Uhrzeiten in das entsprechende Monatsblatt geschrieben werden. Ich hoffe jetzt ist es verständlich, ansonsten lade ich Dir morgen eine neue Beispieldatei hoch.

Schönen Abend noch.

Gruß

Ralf


  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Ralf
Geschrieben am: 24.02.2010 06:29:58

Hallo Tino,

nö geht nicht.
Vielleicht kannst Du Dir dies nochmals in der Datei anschauen.

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

Ich habe den Monat Februar etwas verändert. So sieht die Tabelle dann wirklich aus. Der Monat März ist noch nach meinem Demo Stand, der Grundlage für Deine Programmierung war, dort funzt es auch nicht.

Viele Grüße

Ralf


  

Betrifft: AW: Zellenübertrag mit festen Regeln von: Tino
Geschrieben am: 24.02.2010 15:49:04

Hallo,
so funktioiert der Code, allerdings müsstest Du alle Tabellen wie Jan aufbauen.

Sub test_uhrzeit_einfügen_zelle2()
Dim meArTemp(), meArTabelle(), MeARDatum()
Dim A As Long, NextRow As Long
Dim vCol
Dim ArTab, iSH As Integer

'hier die Tabellen anpassen 
ArTab = Array("Jan", "Feb", "Mar", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")

For iSH = Lbound(ArTab) To Ubound(ArTab)
    With Sheets(ArTab(iSH))
        If .Cells(Rows.Count, 1).End(xlUp).Row > 9 Then
            
            meArTemp = .Range("A10", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value2
            Redim Preserve meArTemp(1 To Ubound(meArTemp), 1 To 1)
            MeARDatum = Range("B9:AF9").Value2
            Redim meArTabelle(1 To Ubound(meArTemp) + 1, 1 To Ubound(MeARDatum, 2))
            
            For A = 1 To Ubound(meArTemp)
                If IsNumeric(meArTemp(A, 1)) Then
                    vCol = Application.Match(Fix(meArTemp(A, 1)), MeARDatum, 0)
                    If IsNumeric(vCol) Then
                        NextRow = meArTabelle(Ubound(meArTabelle), vCol) + 1
                        meArTabelle(Ubound(meArTabelle), vCol) = NextRow
                        meArTabelle(NextRow, vCol) = meArTemp(A, 1) - Fix(meArTemp(A, 1))
                    End If
                End If
            Next A
        
            With .Range("B10").Resize(Ubound(meArTabelle) - 1, Ubound(meArTabelle, 2))
                .Value = meArTabelle
                .NumberFormat = "h:mm:ss"
                .EntireColumn.AutoFit
            End With
        End If
    End With
Next iSH

End Sub
Gruß Tino


  

Betrifft: hier noch mit Tabelle Temp von: Tino
Geschrieben am: 24.02.2010 16:49:17

Hallo,
so jetzt werden die Daten auch in die Tabelle Temp ab Q6 mit eingetragen.

Sub test_uhrzeit_einfügen_zelle2()
Dim meArTemp(), meArTabelle(), MeARDatum()
Dim A As Long, NextRow As Long
Dim vCol
Dim ArTab, iSH As Integer
Dim rngTemp As Range

'Tabelle Temp 
With Tabelle2
    Set rngTemp = .Range("Q6") 'erste Zelle von Liste 
    rngTemp.Resize(.Cells(.Rows.Count, rngTemp.Column).End(xlUp).Row + 1).ClearContents
End With
'hier die Tabellen anpassen 
ArTab = Array("Jan", "Feb", "Mar", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez")

For iSH = Lbound(ArTab) To Ubound(ArTab)
    With Sheets(ArTab(iSH))
        If .Cells(Rows.Count, 1).End(xlUp).Row > 9 Then
            
            meArTemp = .Range("A10", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2).Value2
            Redim Preserve meArTemp(1 To Ubound(meArTemp), 1 To 1)
            MeARDatum = Range("B9:AF9").Value2
            Redim meArTabelle(1 To Ubound(meArTemp) + 1, 1 To Ubound(MeARDatum, 2))
            
            For A = 1 To Ubound(meArTemp)
                If IsNumeric(meArTemp(A, 1)) Then
                    vCol = Application.Match(Fix(meArTemp(A, 1)), MeARDatum, 0)
                    If IsNumeric(vCol) Then
                        NextRow = meArTabelle(Ubound(meArTabelle), vCol) + 1
                        meArTabelle(Ubound(meArTabelle), vCol) = NextRow
                        meArTabelle(NextRow, vCol) = meArTemp(A, 1) - Fix(meArTemp(A, 1))
                    End If
                End If
            Next A
        
            With .Range("B10").Resize(Ubound(meArTabelle) - 1, Ubound(meArTabelle, 2))
                .Value = meArTabelle
                .NumberFormat = "h:mm:ss"
                .EntireColumn.AutoFit
            End With
            
            'in Temp Tabelle eintragen 
            With rngTemp.Resize(Ubound(meArTemp))
             .Value = meArTemp 'Daten eintragen 
             .NumberFormat = "dd/mm/yyyy hh:mm;@" 'Zellen Formatieren 
             Set rngTemp = rngTemp.Offset(.Cells.Count, 0) 'nächte freie Zelle 
            End With
            
        End If
    End With
Next iSH

End Sub
Gruß Tino


  

Betrifft: AW: hier noch mit Tabelle Temp von: Ralf
Geschrieben am: 25.02.2010 07:10:24

Hallo Tino,

wahnsinn.
Du machst Dir vielleicht eine Arbeit.
Ich habe das Makro in der echten - "produktiven" - Datei getestet. Es funzt leider aus mir unerklärlichen Gründen nicht. Ich habe das Makro in der Zeile der Tabellenbezeichnungen etwas angepasst. Ist das vielleicht der Fehler?
Ich habe den Monat Februar mit Demo Daten befüllt. Nach Start Deines Makros wird jede Menge gelöscht. Ich weiß nur nicht warum, und nach welchen Regeln. Vielleicht kannst Du Dir die Tabelle noch ein letztes mal anschauen und so korrigieren, dass es funktioniert.

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

Danke, danke, danke.

Viele Grüße

Ralf


  

Betrifft: Datei ist nicht wie Beispiel von: Tino
Geschrieben am: 25.02.2010 15:50:44

Hallo,
die Datei ist auch anders aufgebaut wie Dein Beispiel, dafür müsste ich einiges wieder umbauen.
Die Monatstabellen haben jetzt noch das Jahr dabei stehen, dies ist im Makro nicht angepasst.
Kann auch die Temp Zeile in den Tabellen nicht finden wo die Daten eingetragen sind.

Passe einfach die Datei an wie in Deinem Beispiel und es sollte funktioniert.

Gruß Tino


Beiträge aus den Excel-Beispielen zum Thema "Zellenübertrag mit festen Regeln"