Office: Zellen kopieren

hary · 27. Juni 2018

Moin
T'schuldigung fuers dazwischen schreiben.;-)
Bezogen auf #41
Eine Moeglichkeit.
Code:

Dim rngLast As Range, rngFirst As Range, Zelle As Range
With Worksheets("Rechnungen")
Set rngLast = .Range("C:C").Find(what:="noch zu zahlen", after:=.Range("C1"), searchdirection:=xlPrevious)
Set rngFirst = .Range("C:C").Find(what:="Gesamtsumme", after:=rngLast, searchdirection:=xlNext)
For Each Zelle In .Range(rngFirst.Offset(1, 4), rngLast.Offset(-1, 4))
Zelle.EntireRow.Hidden = Zelle = 0 '--blendet ein/aus je nach dem Null oder ungleich Null
Next
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn das die betr. Blaetter sind

die Kandidaten sind also: Nachlass, schon gezahlt, AZ Einbehalt, Versicherung.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

einfach 'ne Schleife.
gruss hary

Macanudo · 28. Juni 2018

Hallo hary,

kein Problem. Danke dir für den Code. Diesen habe ich für meine Statistik verwenden können.
Vielen Dank.

Viele Grüße
Uwe

aloys78 · 28. Juni 2018

Hallo Uwe,

Diesen habe ich für meine Statistik verwenden können.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ist damit das Problem des Ausblendens gelöst ?

Gruß
Aloys

Macanudo · 28. Juni 2018

Hallo Aloys,

für die Statistik ja. Das ist aber eine andere Datei.

Leider ist es bei der anderen Datei nicht gelöst. Weiß nicht, wie ich den einpflegen soll, damit er an der richtigen Stelle ausblendet und wieder einblendet.

Vielen Dank.

Viele Grüße

Uwe

aloys78 · 28. Juni 2018

Hallo Uwe,

mein Vorschlag (ungetestet):

1. Prozedur
Code:

' Abzüge darstellen
.Range("C" & r + 1) = IIf(Q.Range("iNachlass") = 0, "Nachlass", Q.Range("iNachlass") * 1 & "% Nachlass") ' Nachlass
.Range("C" & r + 1).HorizontalAlignment = xlLeft
.Range("G" & r + 1) = IIf(Q.Range("iNachlass") = 0, 0, Q.Range("iNachlass") * Summe * (-0.01))
.Range("G" & r + 1) = WorksheetFunction.Round(.Range("G" & r + 1), 2)
.Range("G" & r + 1).NumberFormat = F_Buchhaltung
If .Range("G" & r + 1) = 0 Then .Rows(r + 1).Hidden = True

.Range("C" & r + 2) = IIf(Q.Range("iNachlass1") = 0, "Bauwesenversicherung", Q.Range("iNachlass1") * 1 & "% Versicherung") ' Versicherung
.Range("C" & r + 2).HorizontalAlignment = xlLeft
.Range("G" & r + 2) = (Summe + .Range("G" & r + 1)) * -Q.Range("iNachlass1") * -(-0.01)
.Range("G" & r + 2) = WorksheetFunction.Round(.Range("G" & r + 2), 2)
.Range("G" & r + 2).NumberFormat = F_Buchhaltung
If .Range("G" & r + 2) = 0 Then .Rows(r + 2).Hidden = True

.Range("C" & r + 3) = "10% AZ Einbehalt" ' AZ Einbehalt für Summe - Nachlass
.Range("C" & r + 3).HorizontalAlignment = xlLeft
.Range("G" & r + 3) = (Summe + .Range("G" & r + 1)) * -0.1
.Range("G" & r + 3) = WorksheetFunction.Round(.Range("G" & r + 3), 2)
.Range("G" & r + 3).NumberFormat = F_Buchhaltung
If .Range("G" & r + 3) = 0 Then .Rows(r + 3).Hidden = True

.Range("C" & r + 4) = "bereits gezahlt" ' bereits gezahlt
.Range("C" & r + 4).HorizontalAlignment = xlLeft
.Range("G" & r + 4) = -Q.Range("iGezahlt")
.Range("G" & r + 4) = WorksheetFunction.Round(.Range("G" & r + 4), 2)
.Range("G" & r + 4).NumberFormat = F_Buchhaltung
If .Range("G" & r + 4) = 0 Then .Rows(r + 4).Hidden = True
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

2. Prozedur
Code:

' check Status Ziel-Tabelle
If LRowZ < zStart Then ' Ziel-Tabelle noch ohne Eintrag
r = zStart

ElseIf LRowZ2 > LRowZ Then ' letzte Zeile ist Gesamtsumme (Sp G enthält mehr Einträge als Sp A)
With Z
r = LRowZ2 - 7
.Range("C" & r + 1 & ":G" & LRowZ2).ClearContents ' bisherige Daten für Gesamtsumme löschen
.Rows(r & ":" & LRowZ2).Hidden = False ' etwa ausgeblendete Zeilen im Block Gesamtsumme einblenden
.Range("C" & r + 1 & ":G" & LRowZ2).HorizontalAlignment = xlRight ' Daten mittig ausrichten
.Range("C" & r) = TxT ' Text Gesamtsumme durch Zwischensumme ersetzen
.Range("C" & LRowZ2).Font.Bold = False
.Range("G" & LRowZ2).Font.Bold = False ' Fett entfernen
r = r + nRows
End With

Else ' letzte Zeile = Tabelle schon mit Daten, aber noch ohne Gesamtsumme
r = LRowZ + 1
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

Macanudo · 28. Juni 2018

Hallo Aloys,

vielen lieben Dank für die Hilfe. Auch das ist wieder perfekt.

Ich hoffe, dass ich das Thema jetzt nicht mehr hochholen muss.

Vielen Dank.

Viele Grüße

Uwe

Office: Zellen kopieren

Zellen kopieren

Zellen kopieren

Zellen kopieren

Zellen kopieren - Similar Threads - Zellen kopieren

Nur markierte Zellen kopieren und wieder einfügen

Zellen aus Aktiver Zeile kopieren

Excel VBA - Code Hilfe (Spalten, Werte kopieren etc.)

Wert einer Zelle kopieren wenn..

Wenn in Zelle bestimmter Wert dann kopieren

Textausgabe eines Formelergebnisses in anderer Zelle

Zellen automatisch in ein neues Blatt kopieren wenn