Berechnungen und Druck Ausgabe

Hallo,
ich habe ein Tabellenblatt mit verschiedensten Werten und möchte einen Teil dieser Werte zu erst Berechnen und dann Übersichtlich ausdrucken (bis dahin bin ich aber noch nicht).
Die Idee war jetzt erstmal alle relevanten Daten in einem extra Tabellenblatt zusammenzustellen und zu berechnen, das klappt auch so wie es aussieht. Allerdings bin ich mir eigentlich sicher das man das einfacher/besser machen könnte. Daher wäre es nett wenn ihr euch das mal ansehen könntet und mich gerne auf Fehler und Verbesserungs möglichkeiten hinweisen würdet. Wenn das dann soweit passt würde ich mich an den optisch "schönen" ausdruck machen.
Zur erklärung der Beispieldatei, im Tabellenblatt "Tabelle1" gibt es 81 Spalten mit einer Variablen Anzahl Zeilen, über eine Variable wird ein Jahr festgelegt und wenn diese mit dem Wert in Spalte 3 übereinstimmt, dann werden weiter Spalte gepürft und ins Tabellenblatt "Tabelle2" kopiert, zuerst ob Spalte 13=True ist, wenn ja, dann ob Spalte 11"" ist, wenn dem so ist ob Spalte 12 leer ist, wenn dem so ist wird Spalte 11*12 gerechnet, ansonsten Spalte 11*Spalte 29, das geht so weiter bis Spalte 22.
Ich hab die zu betrachtenden Spalten mal hell blau eingefärbt, das man sie besser erkennt und in Tabelle2 mal die Spalte aus der die Werte in Tabelle1 kommen sollten in Zeile1 geschrieben.
Ich hoffe mein Vorhaben ist verständlich.
Danke
https://www.herber.de/bbs/user/152598.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim Jahr As Integer Dim wksZiel As Worksheet Dim lngZeile As Long, lngLetzte As Long Dim intSpalte As Integer, intZaehler As Integer Jahr = CInt(2022) Set wksZiel = Tabelle2 With Tabelle1 wksZiel.Range("2:" & .Rows.Count).Delete For lngZeile = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row If .Cells(lngZeile, 3) = Jahr Then lngLetzte = wksZiel.Cells(.Rows.Count, 3).End(xlUp).Row + 1 wksZiel.Range(wksZiel.Cells(lngLetzte, 1), wksZiel.Cells(lngLetzte, 3)).Value = .Range(.Cells(lngZeile, 1), .Cells(lngZeile, 3)).Value intZaehler = 0 For intSpalte = 11 To 26 Step 3 If .Cells(lngZeile, intSpalte + 2) = True Then intZaehler = intZaehler + 4 wksZiel.Cells(lngLetzte, intZaehler).Value = .Cells(lngZeile, intSpalte).Value If .Cells(lngZeile, intSpalte) = "" And .Cells(lngZeile, intSpalte + 1) = "" Then wksZiel.Cells(lngLetzte, intZaehler + 2).Value = .Cells(lngZeile, 29).Value ElseIf .Cells(lngZeile, intSpalte + 1).Value = "" Then wksZiel.Cells(lngLetzte, intZaehler + 1).Value = 0 wksZiel.Cells(lngLetzte, intZaehler + 2).Value = .Cells(lngZeile, 29).Value wksZiel.Cells(lngLetzte, intZaehler + 3).Value = CCur(.Cells(lngZeile, intSpalte).Value * .Cells(lngZeile, 29).Value) Else wksZiel.Cells(lngLetzte, intZaehler + 1).Value = .Cells(lngZeile, intSpalte + 1).Value wksZiel.Cells(lngLetzte, intZaehler + 2).Value = 0 wksZiel.Cells(lngLetzte, intZaehler + 3).Value = CCur(.Cells(lngZeile, intSpalte).Value * .Cells(lngZeile, intSpalte + 1).Value) End If Else Exit For End If Next intSpalte End If Next lngZeile End With End Sub

Hi Chris,
vielen Dank für dein Beispiel, an zwei Schleifen hatte ich auch schon gedacht, aber mir war keine richtige Lösung eingefallen.
Ein bisschen muss ich keinen Code anpassen, da er noch nicht so genau das machte wie mein Beispiel und was er machen soll, aber glaube so hab ich es jetzt das es funktioniert.


Option Explicit
Sub t()
Dim Jahr As Integer
Dim wksZiel As Worksheet
Dim lngZeile As Long, lngLetzte As Long
Dim intSpalte As Integer, intZaehler As Integer
Jahr = CInt(2022)
Set wksZiel = Tabelle2
With Tabelle1
wksZiel.Range("2:" & .Rows.Count).Delete
For lngZeile = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
If .Cells(lngZeile, 3) = Jahr Then
lngLetzte = wksZiel.Cells(.Rows.Count, 3).End(xlUp).Row + 1
wksZiel.Range(wksZiel.Cells(lngLetzte, 1), wksZiel.Cells(lngLetzte, 3)).Value = .Range(.Cells(lngZeile, 1), .Cells(lngZeile, 3)).Value
intZaehler = 0
For intSpalte = 11 To 22 Step 3
If .Cells(lngZeile, intSpalte + 2) = True Then
intZaehler = intZaehler + 4
wksZiel.Cells(lngLetzte, intZaehler).Value = .Cells(lngZeile, intSpalte).Value
If .Cells(lngZeile, intSpalte + 1)  "" Then
wksZiel.Cells(lngLetzte, intZaehler + 1).Value = .Cells(lngZeile, intSpalte + 1).Value
wksZiel.Cells(lngLetzte, intZaehler + 2).Value = 0
wksZiel.Cells(lngLetzte, intZaehler + 3).Value = CCur(.Cells(lngZeile, intSpalte).Value * .Cells(lngZeile, intSpalte + 1).Value)
ElseIf .Cells(lngZeile, intSpalte).Value = "" And .Cells(lngZeile, intSpalte + 1).Value = "" Then
wksZiel.Cells(lngLetzte, intZaehler).Value = 0
wksZiel.Cells(lngLetzte, intZaehler + 1).Value = 0
wksZiel.Cells(lngLetzte, intZaehler + 2).Value = 0
wksZiel.Cells(lngLetzte, intZaehler + 3).Value = 0
Else
wksZiel.Cells(lngLetzte, intZaehler + 2).Value = .Cells(lngZeile, 29).Value
wksZiel.Cells(lngLetzte, intZaehler + 1).Value = 0
wksZiel.Cells(lngLetzte, intZaehler + 3).Value = CCur(.Cells(lngZeile, intSpalte).Value * .Cells(lngZeile, 29).Value)
End If
Else
Exit For
End If
Next intSpalte
End If
Next lngZeile
End With
End Sub

Noch eine Frage zu


lngLetzte = wksZiel.Cells(.Rows.Count, 3).End(xlUp).Row + 1

gibt es einen besonderen grund wieso du das so machst und nicht z.b. so


lngLetzte = wksZiel.Range("C1").CurrentRegion.Rows.Count + 1

Danke
MFG Thomas

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread