Anzeige

 Excel VBA - Bericht erstellen


jerry0110

Erfahrenes Mitglied
#1
Hallo zusammen,

ich möchte gerne aus einem Sheet mit vielen Daten einen Bericht in einem anderen Sheet erstellen.
Dabei soll nach der Kalenderwoche gesucht werden und dann wenn er in einer bestimmten Zellen die Kalenderwoche gefunden hat, bestimmte Felder kopieren und einfügen.

Ich habe so angefangen, nur komme ich nicht so weiter. Ich habe wieder einen Denkfehler. Und ab " If WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("Orig").Range("J" & i)) = myDate Then" komm ich nicht weiter weil er sagt, er kann es nicht auflösen. Wenn ich eine Msgbox nehme, löst er WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("Orig").Range("J" & i)) auf.

Ich weiß, dass ich ab "LastRowNrInTarget = LastRowNrInTarget + 1" noch eine weitere Schleife einbauen muss, damit er im Report auch eine Zeile weiterspringt. Aber ich komme hier nicht auf die Lösung.

Visual Basic:
Sub DGB_Bericht()

Dim myDate As Integer
Dim source As Worksheet
Dim target As Worksheet
Dim LastRowNrInTarget As Long
Dim f As Long
Dim i As Long
 
'die aktuelle Kalenderwoche des Reports 
myDate = ActiveWorkbook.Worksheets("DGB Bericht").Range("F2")
 
Set source = ThisWorkbook.Worksheets("Orig")
Set target = ActiveWorkbook.Worksheets("DGB Bericht")
    

'letzte Ziele im Ziel berechnen
LastRowNrInTarget = lastRowNr(target)

'im Sheet Orig schauen ob das myDate gleich der Kalenderwoche aus Bericht ist
For i = lastRowNr(source) To 1 Step -1
'Ist Kalenderwoche gleich Kalenderwoche aus myDate
    If WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("Orig").Range("J" & i)) = myDate Then
        LastRowNrInTarget = LastRowNrInTarget + 1
                source.Range("P" & i).Value = target.Range("A6").Value
                source.Range("AD" & i).Value = target.Range("B6").Value
                source.Range("R" & i).Value = target.Range("D6").Value
                source.Range("W" & i).Value = target.Range("E6").Value
                source.Range("AV" & i).Value = target.Range("F6").Value
                source.Range("AD" & i).Value = target.Range("G6").Value
                source.Range("L" & i).Value = target.Range("H6").Value
                source.Range("H" & i).Value = target.Range("I6").Value
                source.Range("M" & i).Value = target.Range("J6").Value
                source.Range("BD" & i).Value = target.Range("K6").Value
                source.Range("J" & i).Value = target.Range("L6").Value
                source.Range("O" & i).Value = target.Range("M6").Value
                source.Range("P" & i).Value = target.Range("N6").Value
         End If
    Next i

End Sub
 

Yaslaw

n/a
Moderator
#2
Ist wirklich in jedem Feld der Spalte J ein Datum drin?
Schau dir mal die Zeile an, bei der der Fehler kommt.

Der Rest vom Code scheint mir komisch zu sein. Du ersetzt die Source durch den Target? Sollte das nicht umgekehrt sein?
Und beim Target solltest du die Zeile anpassenb....
 

jerry0110

Erfahrenes Mitglied
#3
Also in Spalte J ist nicht immer ein Datum drin. Mal nichts, mal Text. Aber in der Zukunft steht immer ein Datum drin.

Mit dem Rest hast du Recht. Hab das vertauscht.:cautious:

Jedoch komme ich da ja auch nicht weiter.
Ich möchte ja, dass im Sheet für den Report, dann in jede Zeile die Werte geschrieben werden und wenn er wieder ein Datum findet, in die nächste Zeile geht. Und das bekomme ich nicht hin.
 

Yaslaw

n/a
Moderator
#4
Also in Spalte J ist nicht immer ein Datum drin. Mal nichts, mal Text. Aber in der Zukunft steht immer ein Datum drin.
Dann solltest du das Feld zuerst auf Datum prüfen isDate() bevor du eine Datumsfunktion darauf anwendest.
Visual Basic:
    if isDate(source.Range("J" & i)) Then
        If WorksheetFunction.WeekNum(source.Range("J" & i)) = myDate Then
            LastRowNrInTarget = LastRowNrInTarget + 1
 

jerry0110

Erfahrenes Mitglied
#5
So Jetzt findet es die richtigen. Und fügt die dann auch ein. Erstmal immer in der gleichen Zeile.
Jetzt habe ich mich noch in dem 2ten Teil versucht. Nur jetzt trägt er in jeder zeile die gleichen Werte ein.
Aber ich kann erkennen, dass er alles was er gefunden hat immer in alle Zeilen schreibt.

Visual Basic:
Sub DGB_Bericht()

Dim myDate As Integer
Dim source As Worksheet
Dim target As Worksheet
Dim LastRowNrInTarget As Long
Dim f As Long
Dim i As Long
 
 
myDate = ActiveWorkbook.Worksheets("DGB Bericht").Range("F2")
 
Set source = ThisWorkbook.Worksheets("Orig")
Set target = ActiveWorkbook.Worksheets("DGB Bericht")
    

    'letzte Ziele im Ziel berechnen
LastRowNrInTarget = lastRowNr(target)

    'im Sheet Orig schauen ob das myDate gleich der Kalenderwoche aus Bericht ist
For i = lastRowNr(source) To 1 Step -1
    If IsDate(source.Range("J" & i)) Then
        If WorksheetFunction.WeekNum(ThisWorkbook.Worksheets("Orig").Range("J" & i)) = myDate Then
            LastRowNrInTarget = LastRowNrInTarget + 1
                For f = lastRowNr(target) To 6 Step -1
                    target.Range("A" & f).Value = source.Range("P" & i).Value
                    target.Range("B" & f).Value = source.Range("AD" & i).Value
                    target.Range("D" & f).Value = source.Range("R" & i).Value
                    target.Range("E" & f).Value = source.Range("W" & i).Value
                    target.Range("F" & f).Value = source.Range("AV" & i).Value
                    target.Range("G" & f).Value = source.Range("AD" & i).Value
                    target.Range("H" & f).Value = source.Range("L" & i).Value
                    target.Range("I" & f).Value = source.Range("H" & i).Value
                    target.Range("J" & f).Value = source.Range("M" & i).Value
                    target.Range("K" & f).Value = source.Range("BD" & i).Value
                    target.Range("L" & f).Value = source.Range("J" & i).Value
                    target.Range("M" & f).Value = source.Range("O" & i).Value
                    target.Range("N" & f).Value = source.Range("P" & i).Value
                Next f
         End If
    End If
Next i

End Sub
 

Yaslaw

n/a
Moderator
#6
Was soll das bewirken?
Damit überschreibst du alles unterhalb der Zeile 6.
Somit hast du am Ende nur den letzten Eintrag drin.
Visual Basic:
For f = lastRowNr(target) To 6 Step -1
sollte es nicht eher so sein?
Visual Basic:
LastRowNrInTarget = LastRowNrInTarget + 1
target.Range("A" & LastRowNrInTarget).Value = source.Range("P" & i).Value
 

Yaslaw

n/a
Moderator
#8
Ja, aber du iterierst über alle Zeilen unterhalb der Zeile 6 und überschreibst alle.
Mit LastRowNrInTarget = lastRowNr(target) suchst du ja bereits die letzte Zeile des Target. Wenn keine Daten vorhanden sind, dann ist das die 5 mit den Überschriften drin.
Später zählst du 1 hoch: LastRowNrInTarget = LastRowNrInTarget + 1. Somit bist du automatisch auf der nächst freien Zeile. ALso lass das mit dem For f=.... weg und setze es so um wie ich vorgeschlagen habe
 

jerry0110

Erfahrenes Mitglied
#9
Sorry der 2te Teil mit dem u. s. wurde gerade nicht angezeigt. Nur der den ich zitiert habe.

Visual Basic:
LastRowNrInTarget = LastRowNrInTarget + 1
target.Range("A" & LastRowNrInTarget).Value = source.Range("P" & i).Value


Kann geschlossen werden. funktioniert
 
Anzeige
Anzeige