OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken

Dieses Thema OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken im Forum "Microsoft Office Suite" wurde erstellt von Nepomuk78, 5. Feb. 2004.

Thema: OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken Hallo liebe Helfer, hab da mal ne Frage. Ich mache in EXCEL folgende eingabe 000 000 000 000|

  1. Hallo liebe Helfer,

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

    000 000 000 000|
     
  2. Ola und denn ;D
     
  3. 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!
     
  4. Ola,

    das ist verständlich und auch zu lösen ... allerdings musst Du ein wenig Geduld haben, bis ein Makrospezi hereinschaut
     
  5. Na dann drück ich mir mal die Daumen.

    Danke Dir!
     
  6. Ola,

    registrierte Nutzer können sich per Mail über neue Einträge benachrictigen lassen ....
     
  7. 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 :)
     
  8. 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
     
  9. 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 = &Arial,Fett&12 & Sortierte Zahlen
        .CenterFooter = &9&P/&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 <> 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
    
     
  10. 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 = &Arial,Fett&12 & Sortierte Zahlen
        .CenterFooter = &9&P/&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 <> 0 Or ws_z.VPageBreaks.Count <> 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 <> 0 Or ws_z.VPageBreaks.Count <> 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 <> 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
     
Die Seite wird geladen...

OfficeXP: Excel -> Seitenweise Zahlen sortiert ausdrucken - Ähnliche Themen

Forum Datum
Versionskonflikt zwischen Office2000 und OfficeXP? Microsoft Office Suite 28. Aug. 2004
PDF Icons unter OfficeXP nicht sichtbar Windows XP Forum 26. Aug. 2004
Problem mit OfficeXP(Installer) Windows XP Forum 2. Juni 2004
Briefumschläge mit OfficeXP Microsoft Office Suite 31. Jan. 2004
OfficeXP Unanttend nach WinXP installieren Microsoft Office Suite 23. Juni 2003