OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken

Nepomuk78 · 05.02.2004

Hallo liebe Helfer,

hab da mal ne Frage.
Ich mache in EXCEL folgende eingabe

000 000 000 000|

PCDjoe · 05.02.2004

Ola und denn ;D

NEpomuk78 · 05.02.2004

da hat sich das Formular einfach submitted obwohl ich noch nicht fertig war. Komisch !?
Also nochmal.
Ich habe in EXCEL (Office XP) folgende Liste mit Zahlen.

Spalte1 |
===== |
000001 |
980010 |
030005 |
000101 |
.
.
.
006005 |
800005 |
000905 |
100005 |

Im Grunde sind das haufenweise Zahlen einfach untereinander weggeschrieben.
Nun soll es die Möglichkeit geben diese Liste aufsteigend zu sortieren, was ja nun kein Problem ist.
Allerdings soll beim Ausdrucken auf eine DinA4 Seite die Zahlen so verteilt werden, dass der ausdruck auf eine Seite passt.
Das heisst die Zahlen sollenspaltenweise, aufsteigend nach unten weggeschrieben/gedruckt werden.
Also in etwa so:

Spalte1 | Spalte2| ...
===== | ===== | ...
000001 | 000101| ...
000002 | 000102| ...
000003 | 000103| ...
000004 | 000104| ...
. | .
. | .
. | .
000098 | 000198| ...
000099 | 000199| ...
000100 | 000200| ...

Geht das mit EXCEL/Office Boardmitteln?

Hoffe das ist verständlich.

Danke!

PCDjoe · 05.02.2004

Ola,

das ist verständlich und auch zu lösen ... allerdings musst Du ein wenig Geduld haben, bis ein Makrospezi hereinschaut

Nepomuk78 · 05.02.2004

Na dann drück ich mir mal die Daumen.

Danke Dir!

PCDjoe · 05.02.2004

Ola,

registrierte Nutzer können sich per Mail über neue Einträge benachrictigen lassen ....

Matjes · 05.02.2004

Hi Nepomuk78,

erstmal hört sich das banal an.

Wenn man etwas darüber nachdenkt, wird's schwierig.

Einfach ist die Sache, wenn Du die Spaltenbreite/-höhe und max Spalten-Anzahl vorgibts.

Wie hast Du dir den die Verteilung deiner Zahlen gedacht ? Geht das ganze über eine Seite hinaus und soll dann das Ganze in einer Verkleinerung ausgegeben werden? Oder passen in einer normalen Schriftgröße alle Zahlen auf eine Seite ?

Gruß Matjes

Nepomuk78 · 06.02.2004

Hi Matjes,
Spaltenbreite/-höhe kann ruhig vorgegeben werden. Die maximalen Spalten eigentlich auch. Allerding nur im Bezug auf einer DinA4 Seite.

Es darf keine Vorgabe für die maximale Anzahl an Zahlen/Werte geben die in das EXCEL Sheet eingetragen werden, da die variieren.

Je nach Menge der Zahlen/Werte die Eingtragen werden, geht das auch über eine Seite hinaus!

Man könnte ja die Spaltenhöhe/-breite, die Spalten anzahl und den Schriftgrad vorgeben, so dass es auf eine A4 Seite passt. So weiss man ja wieviel Zahlen auf eine Seite passen. Werden mehr Zahlen eingegeben wie auf eine Seite passen _müssen zwei Seiten ausgedruckt werden_!

Gruss

Matjes · 06.02.2004

Hi Nepomuk,

hab dir einen Prototypen gestrickt. Schau mal ob er deinen Vorstellungen entspricht.

Datei ist auch per mail unterwegs.

Gebrauchsanleitung:
a) Datei mit Makro öffnen
b) deine Datei öffnen und das Blatt mit den auszugebenden Zahlen aktivieren
c) mit Alt+F8 den Makro ZahlenAufSeiteSortiertInSpaltenAusdrucken aufrufen

Nach kurzer Zeit erscheint eine Seitenvorschau mit den sortierten Zahlen, die Du dann ausdrucken kannst.

Gruß Matjes

Code:

Option Explicit
'*******************************************************
Sub ZahlenAufSeiteSortiertInSpaltenAusdrucken()
'*******************************************************
'Aufrufvoraussetzungen:
'  Zahlen, die sortiert werden sollen, stehen in Spalte A des aktiven Blattes
'  Zahlenformat 000000
'
'Ausgabe:
'  Seitenansicht der Sortierten Zahlen - kann ausgedruckt werden

Const c_AnzSpalten = 10
Const c_AnzZeilenProBlatt = 53
Dim ws_q As Worksheet, ws_z As Worksheet, r As Range
Dim l_rows As Long, l_AnzZahlen As Long, q As Long
Dim l_zZeile As Long, l_zSpalte As Long, l_ZZeileSeitenanfang As Long

'screenupdate abschalten
Application.ScreenUpdating = False

'erstmal eine Kopie des Zahlenblattes anlegen
  ActiveSheet.Copy after:=ActiveSheet
  Set ws_q = ActiveSheet

'Zahlen aufsteigend sortieren
  l_rows = ws_q.Cells(ws_q.Rows.Count, 1).End(xlUp).Row
  ws_q.Range(ws_q.Cells(1, 1), ws_q.Cells(l_rows, 1)).Sort _
      Key1:=ws_q.Cells(1, 1), Order1:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom

'Anzahl der auszugebenden Zahlen feststellen
  l_AnzZahlen = ws_q.Cells(ws_q.Rows.Count, 1).End(xlUp).Row

'Ausgabeblatt anlegen
  Sheets.Add after:=ActiveSheet
  Set ws_z = ActiveSheet
  
'Ausgabeblatt formatieren - Seitenlayout
  ws_z.PageSetup.PrintArea = 
  With ws_z.PageSetup
    .CenterHeader = &amp;Arial,Fett&amp;12 &amp; Sortierte Zahlen
    .CenterFooter = &amp;9&amp;P/&amp;N
    .LeftMargin = Application.CentimetersToPoints(1)
    .RightMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(2)
    .BottomMargin = Application.CentimetersToPoints(1.5)
    .HeaderMargin = Application.CentimetersToPoints(1.3)
    .FooterMargin = Application.CentimetersToPoints(1.3)
    .PaperSize = xlPaperA4
    .Orientation = xlPortrait
    .CenterHorizontally = True
  End With

'Ausgabeblatt formatieren - Zellen
  ws_z.Range(ws_z.Cells(1, 1), ws_z.Cells(1, c_AnzSpalten)).EntireColumn.Select
  With Selection
    .Font.Name = Arial
    .Font.Size = 10
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .ColumnWidth = 8->Spaltenbreite 8 Zeichen
    .NumberFormat = 000000
  End With

'Zahlen auf das Zielblatt übertragen
l_zZeile = 1
l_zSpalte = 1
l_ZZeileSeitenanfang = 1
For q = 1 To l_AnzZahlen
  ws_z.Cells(l_zZeile, l_zSpalte).Value = ws_q.Cells(q, 1).Value
 ->wenn schon alle Zahlen übertragen sind nichts machen
  If q &lt;> l_AnzZahlen Then
   ->wieder eine Spalte voll ?
    If (l_zZeile Mod c_AnzZeilenProBlatt) = 0 Then
      If (l_zSpalte Mod c_AnzSpalten) = 0 Then
       ->Seite voll -> neue Seite
        l_zSpalte = 1
        l_zZeile = l_zZeile + 1
        ws_z.HPageBreaks.Add _
           before:=ws_z.Range(Cells(l_zZeile, 1), Cells(l_zZeile, 1))
        l_ZZeileSeitenanfang = l_zZeile
      Else
       ->nächste Spalte auf gleicher Seite
        l_zSpalte = l_zSpalte + 1
        l_zZeile = l_ZZeileSeitenanfang
      End If
    Else
     ->Spalte noch nicht voll -> nächste Zeile
      l_zZeile = l_zZeile + 1
    End If
  End If
Next

'Grid setzen
  Set r = ws_z.Range(ws_z.Cells(1, 1), _
      ws_z.Cells(l_ZZeileSeitenanfang + c_AnzZeilenProBlatt - 1, c_AnzSpalten))
  r.Borders(xlDiagonalDown).LineStyle = xlNone
  r.Borders(xlDiagonalUp).LineStyle = xlNone
  With r.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous:  .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeTop)
    .LineStyle = xlContinuous:   .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous:   .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeRight)
    .LineStyle = xlContinuous:  .Weight = xlThin:   .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideVertical)
    .LineStyle = xlContinuous:  .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous:  .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With

'Zeilenhöhe setzen
  r.EntireRow.RowHeight = Application.CentimetersToPoints(0.5)

'screenupdate abschalten
  Application.ScreenUpdating = True

'fertiges Blatt/Blätter ausdrucken als Seitenansicht
  ws_z.PrintOut Preview:=True

'zusätzliche Arbeitsblätter wieder löschen
  Application.DisplayAlerts = False
  ws_q.Delete
  ws_z.Delete
  Application.DisplayAlerts = False
  Set ws_q = Nothing: Set ws_z = Nothing: Set r = Nothing
End Sub

Matjes · 07.02.2004

Hi Nepomuk,

ich hab den Makro noch etwas modifiziert. Die max. Spalten- und Zeilenanzahl pro Blatt wird dynamisch ermittelt.

Gruß Matjes

Code:

Option Explicit
'*******************************************************
Sub ZahlenAufSeiteSortiertInSpaltenAusdrucken()
'*******************************************************
'Aufrufvoraussetzungen:
'  Zahlen, die sortiert werden sollen, stehen in Spalte A des aktiven Blattes
'  Zahlenformat 000000
'
'Ausgabe:
'  Seitenansicht der Sortierten Zahlen - kann ausgedruckt werden

Const c_LinkerRand As Double = 1->in cm
Const c_RechtererRand As Double = 1->in cm
Const c_ObererRand As Double = 2->in cm
Const c_UntererRand As Double = 0.9->in cm
Const c_Kopfzeile As Double = 1.3->in cm
Const c_Fusszeile As Double = 0.8->in cm
Const c_ZeilenHöhe As Double = 0.5->in cm
Const c_FontSize = 10
Const c_Font = Arial
Const c_NumberFormat = 000000->sechstellig mit führenden Nullen
Const c_Spaltenbreite = 8->Spaltenbreite 8 Zeichen
Const c_TestAnzSpalten = 50
Const c_TestAnzZeilen = 200

Dim ws_q As Worksheet, ws_z As Worksheet, r As Range
Dim l_rows As Long, l_AnzZahlen As Long, q As Long, x As Long
Dim l_zZeile As Long, l_zSpalte As Long, l_ZZeileSeitenanfang As Long
Dim l_AnzSpaltenProBlatt As Long, l_AnzZeilenProBlatt As Long

'screenupdate abschalten
Application.ScreenUpdating = False

'erstmal eine Kopie des Zahlenblattes anlegen
  ActiveSheet.Copy after:=ActiveSheet
  Set ws_q = ActiveSheet

'Zahlen aufsteigend sortieren
  l_rows = ws_q.Cells(ws_q.Rows.Count, 1).End(xlUp).Row
  ws_q.Range(ws_q.Cells(1, 1), ws_q.Cells(l_rows, 1)).Sort _
      Key1:=ws_q.Cells(1, 1), Order1:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom

'Anzahl der auszugebenden Zahlen feststellen
  l_AnzZahlen = ws_q.Cells(ws_q.Rows.Count, 1).End(xlUp).Row

'Ausgabeblatt anlegen
  Sheets.Add after:=ActiveSheet
  Set ws_z = ActiveSheet
  
'Ausgabeblatt formatieren - Seitenlayout
  ws_z.PageSetup.PrintArea = 
  With ws_z.PageSetup
    .CenterHeader = &amp;Arial,Fett&amp;12 &amp; Sortierte Zahlen
    .CenterFooter = &amp;9&amp;P/&amp;N
    .LeftMargin = Application.CentimetersToPoints(c_LinkerRand)
    .RightMargin = Application.CentimetersToPoints(c_RechtererRand)
    .TopMargin = Application.CentimetersToPoints(c_ObererRand)
    .BottomMargin = Application.CentimetersToPoints(c_UntererRand)
    .HeaderMargin = Application.CentimetersToPoints(c_Kopfzeile)
    .FooterMargin = Application.CentimetersToPoints(c_Fusszeile)
    .PaperSize = xlPaperA4
    .Orientation = xlPortrait
    .CenterHorizontally = True
  End With

'*** maximale Spaltenanzahl ermitteln
'Ausgabeblatt 1 Zeile Spalte 1 bis c_TestAnzSpalten formatieren - Zellen
  ws_z.Range(ws_z.Cells(1, 1), ws_z.Cells(1, c_TestAnzSpalten)).Select
  With Selection
    .Font.Name = c_Font
    .Font.Size = c_FontSize
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .ColumnWidth = c_Spaltenbreite
    .NumberFormat = c_NumberFormat
  End With
  For q = 1 To c_TestAnzSpalten
    ws_z.Cells(1, q).Value = 0
    If ws_z.HPageBreaks.Count &lt;> 0 Or ws_z.VPageBreaks.Count &lt;> 0 Then
      l_AnzSpaltenProBlatt = q - 1
      For x = 1 To q: ws_z.Cells(1, x).Value = : Next
      Exit For
    End If
  Next
'*** Ende: maximale Spaltenanzahl ermitteln

'*** maximale Zeilenanzahl ermitteln
'Ausgabeblatt 1 Spalte Zeile 1 bis c_TestAnzZeilten formatieren - Zellen
  ws_z.Range(ws_z.Cells(1, 1), ws_z.Cells(c_TestAnzZeilen, 1)).Select
  With Selection
    .Font.Name = c_Font
    .Font.Size = c_FontSize
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .NumberFormat = c_NumberFormat
    .EntireRow.RowHeight = Application.CentimetersToPoints(c_ZeilenHöhe)
  End With
  For q = 1 To c_TestAnzZeilen
    ws_z.Cells(q, 1).Value = 0
    If ws_z.HPageBreaks.Count &lt;> 0 Or ws_z.VPageBreaks.Count &lt;> 0 Then
      l_AnzZeilenProBlatt = q - 1
      For x = 1 To q: ws_z.Cells(x, 1).Value = : Next
      Exit For
    End If
  Next
'*** Ende: maximale Zeilenanzahl ermitteln

'Ausgabeblatt formatieren - Zellen
  ws_z.Range(ws_z.Cells(1, 1), ws_z.Cells(1, l_AnzSpaltenProBlatt)).EntireColumn.Select
  With Selection
    .Font.Name = c_Font
    .Font.Size = c_FontSize
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .ColumnWidth = c_Spaltenbreite
    .NumberFormat = c_NumberFormat
  End With

'Zahlen auf das Zielblatt übertragen
l_zZeile = 1
l_zSpalte = 1
l_ZZeileSeitenanfang = 1
For q = 1 To l_AnzZahlen
  ws_z.Cells(l_zZeile, l_zSpalte).Value = ws_q.Cells(q, 1).Value
 ->wenn schon alle Zahlen übertragen sind nichts machen
  If q &lt;> l_AnzZahlen Then
   ->wieder eine Spalte voll ?
    If (l_zZeile Mod l_AnzZeilenProBlatt) = 0 Then
      If (l_zSpalte Mod l_AnzSpaltenProBlatt) = 0 Then
       ->Seite voll -> neue Seite
        l_zSpalte = 1
        l_zZeile = l_zZeile + 1
        ws_z.HPageBreaks.Add before:=ws_z.Range(Cells(l_zZeile, 1), Cells(l_zZeile, 1))
        l_ZZeileSeitenanfang = l_zZeile
      Else
       ->nächste Spalte auf gleicher Seite
        l_zSpalte = l_zSpalte + 1
        l_zZeile = l_ZZeileSeitenanfang
      End If
    Else
     ->Spalte noch nicht voll -> nächste Zeile
      l_zZeile = l_zZeile + 1
    End If
  End If
Next

'Grid setzen
  Set r = ws_z.Range(ws_z.Cells(1, 1), _
      ws_z.Cells(l_ZZeileSeitenanfang + l_AnzZeilenProBlatt - 1, l_AnzSpaltenProBlatt))
  r.Borders(xlDiagonalDown).LineStyle = xlNone
  r.Borders(xlDiagonalUp).LineStyle = xlNone
  With r.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous:  .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeTop)
    .LineStyle = xlContinuous:   .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous:   .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeRight)
    .LineStyle = xlContinuous:  .Weight = xlThin:   .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideVertical)
    .LineStyle = xlContinuous:  .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous:  .Weight = xlThin:  .ColorIndex = xlAutomatic
  End With

'Zeilenhöhe setzen
  r.EntireRow.RowHeight = Application.CentimetersToPoints(c_ZeilenHöhe)

'fertiges Blatt/Blätter ausdrucken als Seitenansicht
  ws_z.PrintOut Preview:=True

'zusätzliche Arbeitsblätter wieder löschen
  Application.DisplayAlerts = False
  ws_q.Delete
  ws_z.Delete
  Application.DisplayAlerts = False
  Set ws_q = Nothing: Set ws_z = Nothing: Set r = Nothing

'screenupdate abschalten
  Application.ScreenUpdating = True
  
End Sub

OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken

Nepomuk78

PCDjoe

NEpomuk78

PCDjoe

Nepomuk78

PCDjoe

Matjes

Nepomuk78

Matjes

Matjes

OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums