AW: Nur Zellen mit Text kopieren
18.06.2009 13:11:20
fcs
Hallo Peter,
ein 2. Blatt auszufüllen ist kein Hexenwerk. Ich halte die Lösung halt nicht für besonders elegant.
Ich hab das Makro mal so angepasst, dass bei Bedarf ein 2. Blatt ausgefüllt wird. Dazu muss du in der datei eine Kopie des Blatts "Heizungen" anlegen und ihm den Namen "Heizungen2" geben. Gleiches für das Blatt "Antriebe". Die Summenformeln in den beiden Blättern muss du dann ggf. anpassen.
Eine PDF-Datei kann man in Excel ja auch über mehrere Seiten erstellen, wenn nötig. Dabei könnte man auch per Makro mit Ein- bzw. Ausblenden von Zeilen arbeiten, um 1 bzw. 2 Seiten zu drucken.
Das Verteilen der Strom-Daten auf die richtigen Spalten ist auch möglich. Dazu muss du die Information zur gewählten Schaltungsart per Formel ebenfalls im Blatt Daten in jeder Zeile erzeugen. Ähnlich wie die Heizungsart, wobei du dann zunächst die Option Buttons mit Zellen verlinken muss. Die Makro_Variante für das Blatt Heizungen zeigt dann die Anpassungen im Makro, wobei die Schaltungsart im Blatt Daten dann jewils in Spalte E und die Stromstärke in Spalte F steht - Spalten ggf. anpassen.
Gruß
Franz
Sub Liste_Heizungen_erstellen()
Dim wksQ As Worksheet, ZeileQ As Long, SpalteQ As Long
Dim wksZ As Worksheet, ZeileZ As Long, SpalteZ As Long
'Tabelle mit Quell-Daten
Set wksQ = Worksheets("Daten")
'Zieltabelle
Set wksZ = Worksheets("Heizungen")
ZeileZ = 9 'Startzeile in Zieltabelle
Application.ScreenUpdating = False
With wksZ
'Alt-Daten (Bereich A9:G44) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(44, 7)).ClearContents
End With
With wksQ
'Zeilen ab Zeile 27 in Spalte B auf 0 prüfen
For ZeileQ = 27 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(ZeileQ, 2) 0 Then
If ZeileZ > 44 Then
'2. Blatt ausfüllen
MsgBox "Es sind nicht genug Zeilen frei um alle Heizungen einzutragen!" _
& vbLf & "Es wird das Blatt ""Heizungen2"" auch ausgefüllt!"
ZeileZ = 9 'Startzeile 2. Blatt
Set wksZ = Worksheets("Heizungen2")
With wksZ
'Alt-Daten (Bereich A9:G44) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(44, 7)).ClearContents
End With
End If
'in Spalte 1 bis 4 (A bis D) die Werte aus Spalte 1 bis 4 (A bis D) eintragen
SpalteZ = 1 'Spalte ab der in Zieltabelle die Werte in jeder Zeile eingetragen _
werden sollen.
'Werte per Schleife eintragen
For SpalteQ = 1 To 4
wksZ.Cells(ZeileZ, SpalteZ).Value = .Cells(ZeileQ, SpalteQ).Value
'Spaltenzähler für Zieltabelle um 1 erhöhen für nächsten Wert in Zeile
SpalteZ = SpalteZ + 1
Next SpalteQ
'Zeilenzähler für Zieltabelle um 1 erhöhen für nächsten Eintrag
ZeileZ = ZeileZ + 1
End If
Next ZeileQ
End With
Application.ScreenUpdating = True
End Sub
Sub Liste_Antriebe_erstellen()
Dim wksQ As Worksheet, ZeileQ As Long, SpalteQ As Long
Dim wksZ As Worksheet, ZeileZ As Long, SpalteZ As Long
'Tabelle mit Quell-Daten
Set wksQ = Worksheets("Daten")
'Zieltabelle
Set wksZ = Worksheets("Antriebe")
ZeileZ = 9 'Startzeile in Zieltabelle
Application.ScreenUpdating = False
With wksZ
'Alt-Daten (Bereich A9:G37) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(37, 7)).ClearContents
End With
With wksQ
'Zeilen ab Zeile 27 in Spalte G auf 0 prüfen
For ZeileQ = 27 To .Cells(.Rows.Count, 7).End(xlUp).Row
If .Cells(ZeileQ, 7) 0 Then
If ZeileZ > 37 Then
'2. Blatt ausfüllen
MsgBox "Es sind nicht genug Zeilen frei um alle Antriebe einzutragen!" _
& vbLf & "Es wird das Blatt ""Antriebe2"" auch ausgefüllt!"
ZeileZ = 9 'Startzeile 2. Blatt
Set wksZ = Worksheets("Antriebe2")
With wksZ
'Alt-Daten (Bereich A9:G37) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(37, 7)).ClearContents
End With
End If
'in Spalte 1 bis 5 (A bis E) die Werte aus Spalte 7 bis 11 (G bis K) eintragen
SpalteZ = 1 'Spalte ab der in Zieltabelle die Werte in jeder Zeile eingetragen _
werden sollen.
'Werte per Schleife eintragen
For SpalteQ = 7 To 11
wksZ.Cells(ZeileZ, SpalteZ).Value = .Cells(ZeileQ, SpalteQ).Value
'Spaltenzähler für Zieltabelle um 1 erhöhen für nächsten Wert in Zeile
SpalteZ = SpalteZ + 1
Next SpalteQ
'Zeilenzähler für Zieltabelle um 1 erhöhen für nächsten Eintrag
ZeileZ = ZeileZ + 1
End If
Next ZeileQ
End With
Application.ScreenUpdating = True
End Sub
'Makro Variante
Sub Liste_Heizungen_erstellen_Var()
Dim wksQ As Worksheet, ZeileQ As Long, SpalteQ As Long
Dim wksZ As Worksheet, ZeileZ As Long, SpalteZ As Long, strSchaltung As String
'Tabelle mit Quell-Daten
Set wksQ = Worksheets("Daten")
'Zieltabelle
Set wksZ = Worksheets("Heizungen")
ZeileZ = 9 'Startzeile in Zieltabelle
Application.ScreenUpdating = False
With wksZ
'Alt-Daten (Bereich A9:G44) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(44, 7)).ClearContents
End With
With wksQ
'Zeilen ab Zeile 27 in Spalte B auf 0 prüfen
For ZeileQ = 27 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(ZeileQ, 2) 0 Then
If ZeileZ > 44 Then
'2. Blatt ausfüllen
MsgBox "Es sind nicht genug Zeilen frei um alle Heizungen einzutragen!" _
& vbLf & "Es wird das Blatt ""Heizungen2"" auch ausgefüllt!"
ZeileZ = 9 'Startzeile 2. Blatt
Set wksZ = Worksheets("Heizungen2")
With wksZ
'Alt-Daten (Bereich A9:G44) löschen in Zieltabelle
.Range(.Cells(ZeileZ, 1), .Cells(44, 7)).ClearContents
End With
End If
'in Spalte 1 bis 4 (A bis D) die Werte aus Spalte 1 bis 4 (A bis D) eintragen
SpalteZ = 1 'Spalte ab der in Zieltabelle die Werte in jeder Zeile eingetragen _
werden sollen.
'Werte per Schleife eintragen
For SpalteQ = 1 To 4
wksZ.Cells(ZeileZ, SpalteZ).Value = .Cells(ZeileQ, SpalteQ).Value
'Spaltenzähler für Zieltabelle um 1 erhöhen für nächsten Wert in Zeile
SpalteZ = SpalteZ + 1
Next SpalteQ
'Wert für Schaltung eintragen
'Schaltungsart aus Daten Spalte E(5) auslesen
strSchaltung = .Cells(ZeileQ, 5).Value
'Stromstärke aus Daten Spalte F (6)in entsprechende Spalte(n) eintragen
Select Case strSchaltung
Case "L1 L2"
wksZ.Cells(ZeileZ, 5).Value = .Cells(ZeileQ, 6).Value
wksZ.Cells(ZeileZ, 6).Value = .Cells(ZeileQ, 6).Value
Case "L1 L3"
wksZ.Cells(ZeileZ, 5).Value = .Cells(ZeileQ, 6).Value
wksZ.Cells(ZeileZ, 7).Value = .Cells(ZeileQ, 6).Value
Case "L2 L3"
wksZ.Cells(ZeileZ, 6).Value = .Cells(ZeileQ, 6).Value
wksZ.Cells(ZeileZ, 7).Value = .Cells(ZeileQ, 6).Value
Case Else
'do nothing
End Select
'Zeilenzähler für Zieltabelle um 1 erhöhen für nächsten Eintrag
ZeileZ = ZeileZ + 1
End If
Next ZeileQ
End With
Application.ScreenUpdating = True
End Sub