geht das kürzer??

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: geht das kürzer?? von: Sebastian
Geschrieben am: 30.03.2005 06:30:50

Hallo zusammen,

ich habe folgenden Code geschrieben:

Windows("Selektion.xls").Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close
Windows("Etiketten Selektion.xls").Activate
Button = InputBox("Bitte geben Sie den zu selektierenden Ort ein: ",
Title:="Gästekartei - Selektion")
Sheets("Tabelle2").Select
Dim wks As Worksheet
Set wks = Workbooks("Etiketten Selektion.xls").Sheets(2)
k = 2
z = 1
y = 1
L1 = Workbooks("Hotel 1.0.xls").Sheets(1).Range("A25")
With Workbooks("KarteiGäste.xls").Sheets(1)
For i = 5 To 65536
If .Cells(i, 8) = Button Then
k = k + 1
Workbooks.Open Filename:=L1 & ":\Hotel 1.0\Kartei\Gäste\" & .Cells(i, 1)
Anr = Range("A1")
ActiveWorkbook.Saved = True
ActiveWindow.Close
z = z + 1
wks.Cells(z, y) = Anr & " " & .Cells(i, 4) & " " & .Cells(i, 3)
z = z + 1
wks.Cells(z, y) = .Cells(i, 5)
z = z + 1
If .Cells(i, 6) = "D" Then
wks.Cells(z, y) = .Cells(i, 7) & " " & .Cells(i, 8)
Else
wks.Cells(z, y) = Cells(i, 6) & "-" & .Cells(i, 7) & " " & .Cells(i, 8)
End If
z = z + 2
If z = 51 And y = 1 Then z = 1: y = 2 'Seite 1 40 Etiketten
ElseIf z = 51 And y = 2 Then z = 1: y = 3
ElseIf z = 51 And y = 3 Then z = 1: y = 4
ElseIf z = 51 And y = 4 Then z = 51: y = 1
ElseIf z = 101 And y = 1 Then z = 51: y = 2 'Seite 2 80 Etiketten
ElseIf z = 101 And y = 2 Then z = 51: y = 3
ElseIf z = 101 And y = 3 Then z = 51: y = 4
ElseIf z = 101 And y = 4 Then z = 101: y = 1
ElseIf z = 151 And y = 1 Then z = 101: y = 2 'Seite 3 120 Etiketten
ElseIf z = 151 And y = 2 Then z = 101: y = 3
ElseIf z = 151 And y = 3 Then z = 101: y = 4
ElseIf z = 151 And y = 4 Then z = 151: y = 1
ElseIf z = 201 And y = 1 Then z = 151: y = 2 'Seite 4 160 Etiketten
ElseIf z = 201 And y = 2 Then z = 151: y = 3
ElseIf z = 201 And y = 3 Then z = 151: y = 4
ElseIf z = 201 And y = 4 Then z = 201: y = 1
ElseIf z = 251 And y = 1 Then z = 201: y = 2 'Seite 5 200 Etiketten
ElseIf z = 251 And y = 2 Then z = 201: y = 3
ElseIf z = 251 And y = 3 Then z = 201: y = 4
ElseIf z = 251 And y = 4 Then z = 251: y = 1
ElseIf z = 301 And y = 1 Then z = 251: y = 2 'Seite 6 240 Etiketten
ElseIf z = 301 And y = 2 Then z = 251: y = 3
ElseIf z = 301 And y = 3 Then z = 251: y = 4
ElseIf z = 301 And y = 4 Then z = 301: y = 1
ElseIf z = 351 And y = 1 Then z = 301: y = 2 'Seite 7 280 Etiketten
ElseIf z = 351 And y = 2 Then z = 301: y = 3
ElseIf z = 351 And y = 3 Then z = 301: y = 4
ElseIf z = 351 And y = 4 Then z = 351: y = 1
ElseIf z = 401 And y = 1 Then z = 351: y = 2 'Seite 8 320 Etiketten
ElseIf z = 401 And y = 2 Then z = 351: y = 3
ElseIf z = 401 And y = 3 Then z = 351: y = 4
ElseIf z = 401 And y = 4 Then z = 401: y = 1
ElseIf z = 451 And y = 1 Then z = 401: y = 2 'Seite 9 360 Etiketten
ElseIf z = 451 And y = 2 Then z = 401: y = 3
ElseIf z = 451 And y = 3 Then z = 401: y = 4
ElseIf z = 451 And y = 4 Then z = 451: y = 1
ElseIf z = 501 And y = 1 Then z = 451: y = 2 'Seite 10 400 Etiketten
ElseIf z = 501 And y = 2 Then z = 451: y = 3
ElseIf z = 501 And y = 3 Then z = 451: y = 4
ElseIf z = 501 And y = 4 Then z = 501: y = 1
ElseIf z = 551 And y = 1 Then z = 501: y = 2 'Seite 11 440 Etiketten
ElseIf z = 551 And y = 2 Then z = 501: y = 3
ElseIf z = 551 And y = 3 Then z = 501: y = 4
ElseIf z = 551 And y = 4 Then z = 551: y = 1
ElseIf z = 601 And y = 1 Then z = 551: y = 2 'Seite 12 480 Etiketten
ElseIf z = 601 And y = 2 Then z = 551: y = 3
ElseIf z = 601 And y = 3 Then z = 551: y = 4
ElseIf z = 601 And y = 4 Then z = 601: y = 1
ElseIf z = 651 And y = 1 Then z = 601: y = 2 'Seite 13 520 Etiketten
ElseIf z = 651 And y = 2 Then z = 601: y = 3
ElseIf z = 651 And y = 3 Then z = 601: y = 4
ElseIf z = 651 And y = 4 Then z = 651: y = 1
ElseIf z = 701 And y = 1 Then z = 651: y = 2 'Seite 14 560 Etiketten
ElseIf z = 701 And y = 2 Then z = 651: y = 3
ElseIf z = 701 And y = 3 Then z = 651: y = 4
ElseIf z = 701 And y = 4 Then z = 701: y = 1
ElseIf z = 751 And y = 1 Then z = 701: y = 2 'Seite 15 600 Etiketten
ElseIf z = 751 And y = 2 Then z = 701: y = 3
ElseIf z = 751 And y = 3 Then z = 701: y = 4
ElseIf z = 751 And y = 4 Then z = 751: y = 1
ElseIf z = 801 And y = 1 Then z = 751: y = 2 'Seite 16 640 Etiketten
ElseIf z = 801 And y = 2 Then z = 751: y = 3
ElseIf z = 801 And y = 3 Then z = 751: y = 4
ElseIf z = 801 And y = 4 Then z = 801: y = 1
ElseIf z = 851 And y = 1 Then z = 801: y = 2 'Seite 17 680 Etiketten
ElseIf z = 851 And y = 2 Then z = 801: y = 3
ElseIf z = 851 And y = 3 Then z = 801: y = 4
ElseIf z = 851 And y = 4 Then z = 851: y = 1
ElseIf z = 901 And y = 1 Then z = 851: y = 2 'Seite 18 720 Etiketten
ElseIf z = 901 And y = 2 Then z = 851: y = 3
ElseIf z = 901 And y = 3 Then z = 851: y = 4
ElseIf z = 951 And y = 4 Then z = 901: y = 1
ElseIf z = 951 And y = 1 Then z = 901: y = 2 'Seite 19 760 Etiketten
ElseIf z = 951 And y = 2 Then z = 901: y = 3
ElseIf z = 951 And y = 3 Then z = 901: y = 4
ElseIf z = 951 And y = 4 Then z = 951: y = 1
ElseIf z = 1001 And y = 1 Then z = 951: y = 2 'Seite 20 800 Etiketten
ElseIf z = 1001 And y = 2 Then z = 951: y = 3
ElseIf z = 1001 And y = 3 Then z = 951: y = 4
End If
Next
End With
MsgBox "Bitte legen Sie die Etiketten für den Selektionsausdruck ein.", Title:="Drucken"
If Range("A1") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
End If
If Range("A51") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, Collate _
:=True
End If
If Range("A101") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, Collate _
:=True
End If
If Range("A151") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=4, To:=4, Copies:=1, Collate _
:=True
End If
If Range("A201") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=5, To:=5, Copies:=1, Collate _
:=True
End If
If Range("A251") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=6, To:=6, Copies:=1, Collate _
:=True
End If
If Range("A301") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=7, To:=7, Copies:=1, Collate _
:=True
End If
If Range("A351") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=8, To:=8, Copies:=1, Collate _
:=True
End If
If Range("A401") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=9, To:=9, Copies:=1, Collate _
:=True
End If
If Range("A451") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=10, To:=10, Copies:=1, Collate _
:=True
End If
If Range("A501") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=11, To:=11, Copies:=1, Collate _
:=True
End If
If Range("A551") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=12, To:=12, Copies:=1, Collate _
:=True
End If
If Range("A601") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=13, To:=13, Copies:=1, Collate _
:=True
End If
If Range("A651") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=14, To:=14, Copies:=1, Collate _
:=True
End If
If Range("A701") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=15, To:=15, Copies:=1, Collate _
:=True
End If
If Range("A751") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=16, To:=16, Copies:=1, Collate _
:=True
End If
If Range("A801") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=17, To:=17, Copies:=1, Collate _
:=True
End If
If Range("A851") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=18, To:=18, Copies:=1, Collate _
:=True
End If
If Range("A901") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=19, To:=19, Copies:=1, Collate _
:=True
End If
If Range("A951") <> "" Then
ActiveWindow.SelectedSheets.PrintOut From:=20, To:=20, Copies:=1, Collate _
:=True
End If
If Range("A1") = "" Then
MsgBox "Keine Datensätze gefunden.", Title:="Gästekartei -Selektion"
End If
KarteiSelektion.Hide
Unload KarteiSelektion

Kann man das ganze irgendwie kürzer machen?

Danke für eure Hilfe.
Gruß
Sebastian.

Bild


Betrifft: AW: geht das kürzer?? von: Worti
Geschrieben am: 30.03.2005 07:41:08

Hallo Sebastian,
die ElseIf kann man eventuell mit Select Case verkürzen, die 20 If-Abfragen zum Ausdrucken kann man in einer Schleife abarbeiten, zB so:
    For I = 0 To 19
        Spalte = 50 * I + 1        
        If Range("A" & Spalte) <> "" Then
           ActiveWindow.SelectedSheets.PrintOut From:=I + 1, To:=I + 1, Copies:=1, Collate:=True
        End If
    Next I

Gruß Worti


Bild


Betrifft: Danke, klappt. von: Sebastian
Geschrieben am: 30.03.2005 07:45:01




 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zellen mit vba umsortieren zusammenfassen"