Excel Frage

sauli · 13. September 2016

Hi, ich hab mal ein wenig experimentiert:

Wenn das Bild ein Hintergrundbild ist, geht folgendes:

Zitat

ActiveSheet.ChartObjects("Diagramm 1").Activate
If ActiveSheet.Range("$A$1").Value = "1" Then
ActiveChart.SetBackgroundPicture ("C:\1.jpg")
ElseIf ActiveSheet.Range("$A$1").Value = "2" Then
ActiveChart.SetBackgroundPicture ("C:\2.jpg")
End If

Wenn das Bild im Diagramm ist:

Zitat

ActiveSheet.ChartObjects("Diagramm 1").Activate
If ActiveChart.Pictures.Count > 0 Then
    ActiveChart.Pictures.Delete
End If

If ActiveSheet.Range("$A$1").Value = "1" Then
    ActiveChart.Pictures.Insert ("C:\1.jpg")
ElseIf ActiveSheet.Range("$A$1").Value = "2" Then
    ActiveChart.Pictures.Insert ("C:\2.jpg")
End If

Ich hoffe, das hilft weiter.

StepDoWn · 22. September 2016

Ich hätte eine relativ komplexe (oder auch nicht?) Frage.

Habe mehrere Excel-Sheets mit jeweils einigen Mappen, sind Zeitaufzeichnungen, 1 Jahr = 1 File, 1 Monat = 1 Mappe. Jetzt gibt es pro Mappe leider nach Datum getrennte Zeilen, sprich quasi immer 2-3 Einträge pro Tag.

Wir hätten gerne eine Ansicht, wo JEDER Tag des Monats eine eigene Zeile bekommt, und falls für den Tag eine Zeile existiert klarerweise mit den Arbeitsstunden/Bezeichnung/usw übertragen (ansonsten leer). Habe das zunächst recht easy mit VLOOKUP lösen können, allerdings war da die Vorlage noch mit 1 Zeile pro Tag. Jetzt mit mehreren Zeilen pro Tag komme ich fürchte ich um ein Script nimmer herum. Dh in Schritt 1 müsste ich alle Stunden eines Datums sammeln und aufsummieren, in Schritt 2 müsste ich quasi einen "leeren" Monat Tag für Tag mit den neuen Summen befüllen.

Anbei ein vereinfachtes Excel-Sheet - Tabelle1 mit den Source Daten, Tabelle 2 mit dem Wunsch-Output (jetzt mal nur für 3 Tage gemacht).

Kann das jemand aus dem Ärmel schütteln? Hab noch nie VBA für Excel programmiert, vom Programm selbst ist ja alles easy, aber wie ich den einzelnen Shit anspreche ist mir unklar. Bzw ja, idealerweise würde ich das Script dann pro Excel-File auf alle Arbeitsmappen anwenden können.

Merci

zeitaufz_raw.xlsx

lx99 · 22. September 2016

- Wie sollen die Spalten Fakturierbar, Projekt und Vorgang behandelt werden? Einfach das erste Vorkommen für die restlichen Zeilen des Tages verwenden?

Silva · 22. September 2016

Also wenn du für jeden Tag in der Spalte von bzw. bis den minimalen bzw. maximalen Wert der Datentabelle haben willst und die Spalte Stunde einfach die Summe ist, dann brauchst nicht VBA.

In die Spalte C (konkret alles für Zeile 2) von "Tabelle2" gehört das als Matrixformel (Ctrl+Shift+Enter):

{=MIN(WENN(Tabelle1!$B$2:$B$29=Tabelle2!B2;Tabelle1!C$2:C$29;""))}

Spalte D:

{=MIN(WENN(Tabelle1!$B$2:$B$29=Tabelle2!C2;Tabelle1!D$2:D$29;""))}

Spalte E

=SUMMEWENN(Tabelle1!$B$2:$B$29;Tabelle2!B2;Tabelle1!$E$2:$E$29)

bearbeitet 22. September 2016 von Silva

StepDoWn · 22. September 2016

lx99 schrieb vor 46 Minuten:

- Wie sollen die Spalten Fakturierbar, Projekt und Vorgang behandelt werden? Einfach das erste Vorkommen für die restlichen Zeilen des Tages verwenden?

Ja, idR sind die denke ich alle identisch (und wenn nicht ist das vernachlässigbar).

Silva schrieb vor 32 Minuten:
Also wenn du für jeden Tag in der Spalte von bzw. bis den minimalen bzw. maximalen Wert der Datentabelle haben willst und die Spalte Stunde einfach die Summe ist, dann brauchst nicht VBA.

In die Spalte C (konkret alles für Zeile 2) von "Tabelle2" gehört das als Matrixformel (Ctrl+Shift+Enter):
{=MIN(WENN(Tabelle1!$B$2:$B$29=Tabelle2!B2;Tabelle1!C$2:C$29;""))}
Spalte D:
{=MIN(WENN(Tabelle1!$B$2:$B$29=Tabelle2!C2;Tabelle1!D$2:D$29;""))}
Spalte E
=SUMMEWENN(Tabelle1!$B$2:$B$29;Tabelle2!B2;Tabelle1!$E$2:$E$29)

Hmyes, nur müsste ich das dann bei allen ~10 Files und jeweils ~12 Arbeitsmappen machen; auch wenns de facto nur Copy & Paste ist, etwas zäh. Meine Hoffnung wäre, dass jemand so eine "alltägliche" Aufgabe easy per VBA lösen kann.

Bevor ichs händisch mache schreib ich mir was in C# oder Java, aber das dauert dann in Summe halt auch wieder ein bissl.

Danke euch schonmal!

lx99 · 22. September 2016

So in etwa?

Voraussetzung ist, dass die Quelldatei das aktive Workbook beim Starten des Makros ist. Die aufsummierten Zeiten werden in eine neue Datei geschrieben.

Zitat

Option Explicit

Sub Zeitaufzeichnung()

Dim wbOld As String
Dim wbNew As String
Dim x As Integer

Dim intSheet As Integer
Dim intDay As Integer
Dim intMonth As Integer
Dim intYear As Integer

Dim rngFound As Range
Dim intRow As Integer

Dim tmStart As Date
Dim tmEnd As Date
Dim tmDay As Double
Dim strFakt As String
Dim strProj As String
Dim strVorg As String
Dim strTaet As String

Application.ScreenUpdating = False

wbOld = ActiveWorkbook.Name

Application.Workbooks.Add
wbNew = ActiveWorkbook.Name

While Workbooks(wbNew).Sheets.Count < 12
    Workbooks(wbNew).Sheets.Add
Wend

For x = 1 To 12
    Workbooks(wbNew).Sheets(x).Name = Format(DateSerial(1, x, 1), "MMMM")
Next x

For intSheet = 1 To Workbooks(wbOld).Sheets.Count
    Workbooks(wbOld).Sheets(intSheet).Activate
    If Range("B2").Value <> "" Then
        intMonth = Month(Range("B2").Value)
        intYear = Year(Range("B2").Value)
        'Zielmonat aufbauen
        intDay = 1
        While intDay <= Day(DateSerial(intYear, intMonth + 1, 0))
            Workbooks(wbNew).Sheets(intMonth).Range("A" & intDay).Value = _
                DatePart("ww", DateSerial(intYear, intMonth, intDay), vbMonday, vbFirstFourDays)
            Workbooks(wbNew).Sheets(intMonth).Range("B" & intDay).Value = _
                DateSerial(intYear, intMonth, intDay)
            tmStart = 0
            tmEnd = 0
            tmDay = 0
            strFakt = ""
            strProj = ""
            strVorg = ""
            strTaet = ""
            Set rngFound = Nothing
            Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay))
            While Not rngFound Is Nothing
                If rngFound.Row > intRow Then
                    intRow = rngFound.Row
                    If Range("C" & intRow).Value < tmStart Or tmStart = 0 Then tmStart = Range("C" & intRow).Value
                    If Range("D" & intRow).Value > tmEnd Then tmEnd = Range("D" & intRow).Value
                    tmDay = tmDay + Range("E" & intRow).Value
                    If strFakt = "" Then strFakt = Range("F" & intRow).Value
                    If strProj = "" Then strProj = Range("G" & intRow).Value
                    If strVorg = "" Then strVorg = Range("H" & intRow).Value
                    If strTaet = "" Then strTaet = Range("I" & intRow).Value
                    Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay), After:=Range("B" & intRow))
                Else
                    Set rngFound = Nothing
                End If
            Wend
            If tmStart > 0 Then
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).Value = tmStart
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).Value = tmEnd
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("E" & intDay).Value = tmDay
                Workbooks(wbNew).Sheets(intMonth).Range("F" & intDay).Value = strFakt
                Workbooks(wbNew).Sheets(intMonth).Range("G" & intDay).Value = strProj
                Workbooks(wbNew).Sheets(intMonth).Range("H" & intDay).Value = strVorg
                Workbooks(wbNew).Sheets(intMonth).Range("I" & intDay).Value = strTaet
            End If
            intDay = intDay + 1
        Wend
        'Header
        Rows(1).EntireRow.Copy
        Workbooks(wbNew).Sheets(intMonth).Rows(1).EntireRow.Insert Shift:=xlDown
        Workbooks(wbNew).Sheets(intMonth).Columns.AutoFit
    End If
Next intSheet

Application.ScreenUpdating = True

End Sub

bearbeitet 22. September 2016 von lx99

StepDoWn · 23. September 2016

lx99 schrieb vor 8 Stunden:

So in etwa?

Voraussetzung ist, dass die Quelldatei das aktive Workbook beim Starten des Makros ist. Die aufsummierten Zeiten werden in eine neue Datei geschrieben.

Das ist schonmal ziemlich :allaaah:

3 Probleme beim Output allerdings:

1) der Tag wird um geshiftet, also im Source ist 7.1. mit 8 Stunden der erste Tag, im Output wird aus dem der 8.1., im Debugging hab ich nicht wirklich gesehen wo das passiert. Allerdings ist die Kopfzeile quasi 2x kopiert (mit Ausnahme der ersten 2 Spalten), evtl liegts daran?

2) Für den Jänner funktionierts also fast perfekt, aber sobald ich im 2. Sheet bin tut er quasi garnix mehr. Eher Random hat er in irgendeinem Monat dann doch nochmal einen Wert.

3) Ich habe der Einfachkeit halber zunächst ausgerechnet in Spalte B angehängte Info abgeschnitten, nach ein paar Zeilen kam dann "Unterschrift Mitarbeiter", das könnte auch ein Problem darstellen, da du ja glaube ich nur auf quasi NICHT NULL prüfst? Habe nochmal ein Source Excel geschrieben, wo die Struktur jetzt ein bisschen genauer übereinstimmt.

Wenn du keine Zeit mehr hast werd ich mich selber durchkämpfen, aber du wirkst ziemlich fit hier; für mich ist neue Syntax immer ein Krampf.

Tausend Dank schonmal!

zeitaufz_raw_2.xlsx

bearbeitet 23. September 2016 von StepDoWn

lx99 · 23. September 2016

Ja sorry, hab vergessen, die Variable intRow wieder zurückzusetzen...war schon a wengal spät gestern

Das mit dem Versatz konnte ich leider nicht nachvollziehen, kann aber vom Debuggen kommen, falls du an irgendeiner Stelle mal das falsche Workbook aktiviert hast.

Bei Fragen oder Erweiterungen (z.B. concat von Tätigkeiten o.Ä.) rühr dich einfach kurz.

Versuchs bitte hiermit nochmal:

Option Explicit

Sub Zeitaufzeichnung()

Dim wbOld As String
Dim wbNew As String
Dim x As Integer

Dim intSheet As Integer
Dim intDay As Integer
Dim intMonth As Integer
Dim intYear As Integer

Dim rngFound As Range
Dim intRow As Integer

Dim tmStart As Date
Dim tmEnd As Date
Dim tmDay As Double
Dim strFakt As String
Dim strProj As String
Dim strVorg As String
Dim strTaet As String

Application.ScreenUpdating = False

wbOld = ActiveWorkbook.Name

Application.Workbooks.Add
wbNew = ActiveWorkbook.Name

While Workbooks(wbNew).Sheets.Count < 12
    Workbooks(wbNew).Sheets.Add
Wend

For x = 1 To 12
    Workbooks(wbNew).Sheets(x).Name = Format(DateSerial(1, x, 1), "MMMM")
Next x

For intSheet = 1 To Workbooks(wbOld).Sheets.Count
    Workbooks(wbOld).Sheets(intSheet).Activate
    If Range("B2").Value <> "" Then
        intMonth = Month(Range("B2").Value)
        intYear = Year(Range("B2").Value)
        'Zielmonat aufbauen
        intDay = 1
        While intDay <= Day(DateSerial(intYear, intMonth + 1, 0))
            Workbooks(wbNew).Sheets(intMonth).Range("A" & intDay).Value = _
                DatePart("ww", DateSerial(intYear, intMonth, intDay), vbMonday, vbFirstFourDays)
            Workbooks(wbNew).Sheets(intMonth).Range("B" & intDay).Value = _
                DateSerial(intYear, intMonth, intDay)
            tmStart = 0
            tmEnd = 0
            tmDay = 0
            strFakt = ""
            strProj = ""
            strVorg = ""
            strTaet = ""
            intRow = 0
            Set rngFound = Nothing
            Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay))
            While Not rngFound Is Nothing
                If rngFound.Row > intRow Then
                    intRow = rngFound.Row
                    If Range("C" & intRow).Value < tmStart Or tmStart = 0 Then tmStart = Range("C" & intRow).Value
                    If Range("D" & intRow).Value > tmEnd Then tmEnd = Range("D" & intRow).Value
                    tmDay = tmDay + Range("E" & intRow).Value
                    If strFakt = "" Then strFakt = Range("F" & intRow).Value
                    If strProj = "" Then strProj = Range("G" & intRow).Value
                    If strVorg = "" Then strVorg = Range("H" & intRow).Value
                    If strTaet = "" Then strTaet = Range("I" & intRow).Value
                    Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay), After:=Range("B" & intRow))
                Else
                    Set rngFound = Nothing
                End If
            Wend
            If tmStart > 0 Then
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).Value = tmStart
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).Value = tmEnd
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("E" & intDay).Value = tmDay
                Workbooks(wbNew).Sheets(intMonth).Range("F" & intDay).Value = strFakt
                Workbooks(wbNew).Sheets(intMonth).Range("G" & intDay).Value = strProj
                Workbooks(wbNew).Sheets(intMonth).Range("H" & intDay).Value = strVorg
                Workbooks(wbNew).Sheets(intMonth).Range("I" & intDay).Value = strTaet
            End If
            intDay = intDay + 1
        Wend
        'Header
        Rows(1).EntireRow.Copy
        Workbooks(wbNew).Sheets(intMonth).Rows(1).EntireRow.Insert Shift:=xlDown
        Workbooks(wbNew).Sheets(intMonth).Columns.AutoFit
    End If
Next intSheet

Application.ScreenUpdating = True

End Sub

StepDoWn · 23. September 2016

lx99 schrieb vor 2 Stunden:

Ja sorry, hab vergessen, die Variable intRow wieder zurückzusetzen...war schon a wengal spät gestern

Das mit dem Versatz konnte ich leider nicht nachvollziehen, kann aber vom Debuggen kommen, falls du an irgendeiner Stelle mal das falsche Workbook aktiviert hast.

Bei Fragen oder Erweiterungen (z.B. concat von Tätigkeiten o.Ä.) rühr dich einfach kurz.

Versuchs bitte hiermit nochmal:


Option Explicit

Sub Zeitaufzeichnung()

Dim wbOld As String
Dim wbNew As String
Dim x As Integer

Dim intSheet As Integer
Dim intDay As Integer
Dim intMonth As Integer
Dim intYear As Integer

Dim rngFound As Range
Dim intRow As Integer

Dim tmStart As Date
Dim tmEnd As Date
Dim tmDay As Double
Dim strFakt As String
Dim strProj As String
Dim strVorg As String
Dim strTaet As String

Application.ScreenUpdating = False

wbOld = ActiveWorkbook.Name

Application.Workbooks.Add
wbNew = ActiveWorkbook.Name

While Workbooks(wbNew).Sheets.Count < 12
    Workbooks(wbNew).Sheets.Add
Wend

For x = 1 To 12
    Workbooks(wbNew).Sheets(x).Name = Format(DateSerial(1, x, 1), "MMMM")
Next x

For intSheet = 1 To Workbooks(wbOld).Sheets.Count
    Workbooks(wbOld).Sheets(intSheet).Activate
    If Range("B2").Value <> "" Then
        intMonth = Month(Range("B2").Value)
        intYear = Year(Range("B2").Value)
        'Zielmonat aufbauen
        intDay = 1
        While intDay <= Day(DateSerial(intYear, intMonth + 1, 0))
            Workbooks(wbNew).Sheets(intMonth).Range("A" & intDay).Value = _
                DatePart("ww", DateSerial(intYear, intMonth, intDay), vbMonday, vbFirstFourDays)
            Workbooks(wbNew).Sheets(intMonth).Range("B" & intDay).Value = _
                DateSerial(intYear, intMonth, intDay)
            tmStart = 0
            tmEnd = 0
            tmDay = 0
            strFakt = ""
            strProj = ""
            strVorg = ""
            strTaet = ""
            intRow = 0
            Set rngFound = Nothing
            Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay))
            While Not rngFound Is Nothing
                If rngFound.Row > intRow Then
                    intRow = rngFound.Row
                    If Range("C" & intRow).Value < tmStart Or tmStart = 0 Then tmStart = Range("C" & intRow).Value
                    If Range("D" & intRow).Value > tmEnd Then tmEnd = Range("D" & intRow).Value
                    tmDay = tmDay + Range("E" & intRow).Value
                    If strFakt = "" Then strFakt = Range("F" & intRow).Value
                    If strProj = "" Then strProj = Range("G" & intRow).Value
                    If strVorg = "" Then strVorg = Range("H" & intRow).Value
                    If strTaet = "" Then strTaet = Range("I" & intRow).Value
                    Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay), After:=Range("B" & intRow))
                Else
                    Set rngFound = Nothing
                End If
            Wend
            If tmStart > 0 Then
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).Value = tmStart
                Workbooks(wbNew).Sheets(intMonth).Range("C" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).Value = tmEnd
                Workbooks(wbNew).Sheets(intMonth).Range("D" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intMonth).Range("E" & intDay).Value = tmDay
                Workbooks(wbNew).Sheets(intMonth).Range("F" & intDay).Value = strFakt
                Workbooks(wbNew).Sheets(intMonth).Range("G" & intDay).Value = strProj
                Workbooks(wbNew).Sheets(intMonth).Range("H" & intDay).Value = strVorg
                Workbooks(wbNew).Sheets(intMonth).Range("I" & intDay).Value = strTaet
            End If
            intDay = intDay + 1
        Wend
        'Header
        Rows(1).EntireRow.Copy
        Workbooks(wbNew).Sheets(intMonth).Rows(1).EntireRow.Insert Shift:=xlDown
        Workbooks(wbNew).Sheets(intMonth).Columns.AutoFit
    End If
Next intSheet

Application.ScreenUpdating = True

End Sub

Whooo

Musste noch ein bissl was adaptieren, was du aber nicht wissen konntest. Teilweise sind die Arbeitsmappen nicht auf 12 Monate beschränkt oder beginnen im Jänner, sondern beginnen im November 2013 und gehen bis Juli 2015 (oder so). Ich habe deswegen noch ein bisserl adaptiert (meistens intMonth ersetzt durch intSheet, und Sheet-Namen kopiert usw). Und bisschen erweitert um 2 Spalten sowie ein bisserl Formatierung und eine Summenfunktion.

Das einzige was ich nicht geschafft habe, ist über mehrere Sheets hinweg eine Range zu bestimmen: wenn ich Sheet1:Sheet27 eingegeben habe, wollt ers nicht, wenn ich "Jänner 2015:Dezember2015" probiert habe ebenso nicht. Deswegen wird die Gesamtstundenanzahl jetzt im Script mitgezählt und ist keine Feldfunktion. Lässt sich verschmerzen, zumal die Dateien ja ohnehin nicht groß verändert werden (sollten :davinci: ) und direkt aus einem Zeiterfassungs Tool kommen. Wäre trotzdem interessant gewesen, wie man die Worksheets per Index ansprechen kann, egal was ich probiert hab, nix hat gefunzt. Sowas hasse ich.

Hätte ich ohne deine Hilfe definitiv nicht so schnell hinbekommen, du kriegst bei Gelegenheit sehr gern 1-17 Bier dafür spendiert. :love: :hagmayr:

Hier noch mein letztlicher Output, falls es dich interessiert:

Option Explicit

Sub Zeitaufzeichnung()

Dim wbOld As String
Dim wbNew As String
Dim x As Integer

Dim intSheet As Integer
Dim intDay As Integer
Dim intMonth As Integer
Dim intYear As Integer

Dim rngFound As Range
Dim intRow As Integer

Dim tmStart As Date
Dim tmEnd As Date
Dim tmDay As Double
Dim strFakt As String
Dim strProj As String
Dim strVorg As String
Dim strTaet As String
Dim strBem As String
Dim strOrt As String
Dim strOrtRel As String
Dim totalHours As Double

Application.ScreenUpdating = False

wbOld = ActiveWorkbook.Name

Application.Workbooks.Add
wbNew = ActiveWorkbook.Name

Dim s As Worksheet

For Each s In Workbooks(wbOld).Sheets
        Workbooks(wbNew).Sheets.Add
        
    Next s

For intSheet = 1 To Workbooks(wbOld).Sheets.Count
    Workbooks(wbNew).Sheets(intSheet).Name = Workbooks(wbOld).Sheets(intSheet).Name
    Workbooks(wbOld).Sheets(intSheet).Activate
    If Range("B2").Value <> "" Then
        intMonth = Month(Range("B2").Value)
        intYear = Year(Range("B2").Value)
        'Zielmonat aufbauen
        intDay = 1
        While intDay <= Day(DateSerial(intYear, intMonth + 1, 0))
            Workbooks(wbNew).Sheets(intSheet).Range("A" & intDay).Value = _
                DatePart("ww", DateSerial(intYear, intMonth, intDay), vbMonday, vbFirstFourDays)
            Workbooks(wbNew).Sheets(intSheet).Range("B" & intDay).Value = _
                DateSerial(intYear, intMonth, intDay)
            tmStart = 0
            tmEnd = 0
            tmDay = 0
            strFakt = ""
            strProj = ""
            strVorg = ""
            strTaet = ""
            strBem = ""
            strOrt = ""
            strOrtRel = ""
            intRow = 0
            Set rngFound = Nothing
            Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay))
            While Not rngFound Is Nothing
                If rngFound.Row > intRow Then
                    intRow = rngFound.Row
                    If Range("C" & intRow).Value < tmStart Or tmStart = 0 Then tmStart = Range("C" & intRow).Value
                    If Range("D" & intRow).Value > tmEnd Then tmEnd = Range("D" & intRow).Value
                    tmDay = tmDay + Range("E" & intRow).Value
                    If strFakt = "" Then strFakt = Range("F" & intRow).Value
                    If strProj = "" Then strProj = Range("G" & intRow).Value
                    If strVorg = "" Then strVorg = Range("H" & intRow).Value
                    If strTaet = "" Then strTaet = Range("I" & intRow).Value
                    If strBem = "" Then strBem = Range("J" & intRow).Value
                    If strOrt = "" Then strOrt = Range("K" & intRow).Value
                    If strOrtRel = "" Then strOrtRel = Range("L" & intRow).Value
                    Set rngFound = Range("B:B").Find(What:=DateSerial(intYear, intMonth, intDay), After:=Range("B" & intRow))
                Else
                    Set rngFound = Nothing
                End If
            Wend
            If tmStart > 0 Then
                Workbooks(wbNew).Sheets(intSheet).Range("C" & intDay).Value = tmStart
                Workbooks(wbNew).Sheets(intSheet).Range("C" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intSheet).Range("D" & intDay).Value = tmEnd
                Workbooks(wbNew).Sheets(intSheet).Range("D" & intDay).NumberFormat = "hh:mm:ss"
                Workbooks(wbNew).Sheets(intSheet).Range("E" & intDay).Value = tmDay
                Workbooks(wbNew).Sheets(intSheet).Range("F" & intDay).Value = strFakt
                Workbooks(wbNew).Sheets(intSheet).Range("G" & intDay).Value = strProj
                Workbooks(wbNew).Sheets(intSheet).Range("H" & intDay).Value = strVorg
                Workbooks(wbNew).Sheets(intSheet).Range("I" & intDay).Value = strTaet
                Workbooks(wbNew).Sheets(intSheet).Range("J" & intDay).Value = strBem
                Workbooks(wbNew).Sheets(intSheet).Range("K" & intDay).Value = strOrt
                Workbooks(wbNew).Sheets(intSheet).Range("L" & intDay).Value = strOrtRel
                
            End If
            totalHours = totalHours + tmDay
            
            intDay = intDay + 1
        Wend
        'Header
        Rows(1).EntireRow.Copy
        Workbooks(wbNew).Sheets(intSheet).Rows(1).EntireRow.Insert Shift:=xlDown
        Workbooks(wbNew).Sheets(intSheet).Columns.AutoFit
        
        'Sum hours, add signature fields
        Workbooks(wbNew).Sheets(intSheet).[D33].Value = "Summe"
        Workbooks(wbNew).Sheets(intSheet).[E33].Value = "=Sum(E2:E32)"
        Workbooks(wbNew).Sheets(intSheet).[B36].Value = "Unterschrift Mitarbeiter:"
        Workbooks(wbNew).Sheets(intSheet).[H36].Value = "Unterschrift Projektleiter:"
        
        'Draw border, line for signature fields
        Workbooks(wbNew).Sheets(intSheet).Range("A1:L32").Borders.LineStyle = xlContinuous
        
        Workbooks(wbNew).Sheets(intSheet).Range("A1:L40").Borders(xlEdgeLeft).Weight = xlThick
        Workbooks(wbNew).Sheets(intSheet).Range("A1:L40").Borders(xlEdgeRight).Weight = xlThick
        Workbooks(wbNew).Sheets(intSheet).Range("A1:L40").Borders(xlEdgeBottom).Weight = xlThick
        Workbooks(wbNew).Sheets(intSheet).Range("A1:L40").Borders(xlEdgeTop).Weight = xlThick
        
        Workbooks(wbNew).Sheets(intSheet).Range("B39:E39").Borders(xlEdgeBottom).Weight = xlThin
        Workbooks(wbNew).Sheets(intSheet).Range("H39:J39").Borders(xlEdgeBottom).Weight = xlThin
        
        
    End If
Next intSheet

'Add sum of all hours to the first Sheet
Workbooks(wbNew).Sheets(1).[B43].Value = "Stunden Gesamt"
Workbooks(wbNew).Sheets(1).[E43].Value = totalHours
Workbooks(wbNew).Sheets(1).Range("B43:E43").Borders(xlEdgeLeft).Weight = xlThick
Workbooks(wbNew).Sheets(1).Range("B43:E43").Borders(xlEdgeRight).Weight = xlThick
Workbooks(wbNew).Sheets(1).Range("B43:E43").Borders(xlEdgeBottom).Weight = xlThick
Workbooks(wbNew).Sheets(1).Range("B43:E43").Borders(xlEdgeTop).Weight = xlThick

Application.ScreenUpdating = True

End Sub

lx99 · 23. September 2016

Super, freut mich, wenn ich helfen konnte :v: .

Die Gesamtstundenzahl hätte ich eigentlich auch so wie du ermittelt. Man könnte auch eine Funktion dafür schreiben, der man die Tabellenblatt-Indizes übergibt (von-bis) - damit würde sich die Gesamtsumme zwar dynamisch ändern, wenn in den einzelnen Sheets eine Änderung der Monatssumme stattfindet, aber dafür müsste die Funktion mit der Zieldatei abgespeichert werden. Vorteil wäre, dass sie wie ein Standard Excel-Befehl anwendbar wäre.

Quick and dirty würde ichs so lassen.

Relii · 20. Oktober 2016

kennt jemand ein gutes online-portal o.ä. das einem die vba programmierung näher bringt?

ich such im grunde soetwas wie selfhtml nur eben für vba. ich kann zwar ein paar basics bzw. komm ich für einfache dinge mittels "google it and edit" oft weiter, ich würd mir das ganze aber "von der pieke auf" auch gerne mal reinziehen.

wenn da jemand ein paar gute links parat hat, bitte her damit!

lx99 · 20. Oktober 2016

Ich muss sagen, ich hab's mir auch kleinweise selbst erarbeitet - je nachdem, was ich grad machen wollte. Ich hab auch keine Ahnung, auf welchem Level du einsteigen willst, aber schau mal hier rein.

Indurus · 20. Oktober 2016

Wie kann man am einfachsten per VBA auf eine Datenbank auf einem SQL Server zugreifen (Lesen und Schreiben)?

Habs mit einer ADODB Connection versucht, aber da muss man immer manuell Verweise einbeziehen (bei jedem Neustart von Excel muss man das wieder aufs neue machen...) Geht da irgendwas ohne händisch irgendwelche Bibliotheken einbinden zu müssen bzw. kann man die Bibliotheken auch irgendwie automatisch, also VBA gesteuert anhaken?

lx99 · 20. Oktober 2016

Die Verweise werden in Excel mit dem Workbook gespeichert. Eine theoretische Möglichkeit könnte sein, dass du ein eigenes Workbook, bei dem du den Verweis auf die ADO Bibliothek setzt, erstellst. Dieses Workbook speicherst du als .xlam ab und kopierst es ins XLSTART Verzeichnis. Dann wird es bei jedem Start von Excel automatisch mitgeöffnet und du solltest auf die darin enthaltenen Funktionen und Makros zugreifen können.

raumplaner · 20. Oktober 2016

Relii schrieb vor 3 Stunden:

ich kann zwar ein paar basics

aber vba ist nicht darunter? :RiedWachler:

Anmelden

Excel Frage

Recommended Posts

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Diesen Beitrag teilen

Link zum Beitrag

Auf anderen Seiten teilen

Join the conversation

Folge uns auf Facebook

Partnerlinks

Unsere Sponsoren und Partnerseiten

Wer ist Online