Microsoft Excel

Herbers Excel/VBA-Archiv

Prozedur fuer mehrere Arbeitsblaetter wiederholen

Betrifft: Prozedur fuer mehrere Arbeitsblaetter wiederholen von: Andrea
Geschrieben am: 26.11.2007 17:58:52

Hallo.

folgendes Makro formatiert die Daten in einem Excel Arbeitsblatt und speichert das Ergebnis in einer Datei. Jedoch tut es dies immer nur fuer das erste Arbeitsblatt in meiner Datei (Sheets(1).Select). Wie kann ich dafuer sorgen, dass das Makro alle Arbeitsblaetter in meiner Datei durchlaeuft?

Danke duer die Hilfe


Sub Format()

Sheets(1).Select

Dim K As String
Dim I As Integer
Dim J As Integer
Dim F As String
Dim AN As String
Dim L As Double
Dim M As Integer
Dim fn As String
Dim K1 As String
Dim IntegerPortion As String
Dim DecimalPortion As String

I = 3

Do While Format(Cells(I, 1)) <> ""

    J = 1
    F = Format(Cells(2, 1))
    
    Do While F <> ""

    AN = Left(F, 1)
    L = Val(Right(F, Len(F) - InStr(F, "-")))
    M = (L - Round(L, 0)) * 10
    
        Select Case AN
        Case "N"
            K1 = Format(Cells(I, J), String(L, "0"))
            If Len(K1) > L Then K1 = Left(K1, L)
            If K1 = "" Then K1 = String(L, "0")
        Case "D"
            IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
            DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0"))
            DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
            K1 = IntegerPortion & DecimalPortion
            If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), "0")  _
 _
+ K1
            If K1 = "" Then K1 = String(L + M, "0")
        Case "A"
            K1 = Format(Cells(I, J))
            If Len(K1) > L Then K1 = Left(K1, L) Else K1 = K1 + Space(L - (Len(K1)))
            If K1 = "" Then K1 = Space(L)
        Case "S"
            IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
            DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0"))
            DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
            K1 = IntegerPortion & DecimalPortion
            If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), "0")  _
 _
+ K1
            If Cells(I, J) < 0 Then K1 = K1 & "-" Else K1 = K1 & " "
            If K1 = "" Then K1 = String(L + M + 1, "0")
        End Select
        
        K = K & K1
        
        J = J + 1
        F = Format(Cells(2, J))
    Loop
    K = K & Chr(10)
    I = I + 1
Loop

fn = "c:\my documents\" & Sheets(1).Name
Open fn For Output Shared As #1
Print #1, K
Close #1

End Sub


  

Betrifft: AW: Prozedur fuer mehrere Arbeitsblaetter wiederholen von: Jens
Geschrieben am: 26.11.2007 18:03:11

Hallo Andrea

Lass alle Blätter in einer For-each-Schleife durchlaufen.

Gruß aus dem Sauerland

Jens


  

Betrifft: AW: Prozedur fuer mehrere Arbeitsblaetter wiederholen von: Andrea
Geschrieben am: 26.11.2007 18:26:54

Danke fuer die Antwort Jens. Ich habe zwar von VBA keine Ahnung, habe aber mal rumprobiert. Dabei kam folgendes raus:

Sub Gateway()

Dim K As String
Dim I As Integer
Dim J As Integer
Dim F As String
Dim AN As String
Dim L As Double
Dim M As Integer
Dim fn As String
Dim K1 As String
Dim IntegerPortion As String
Dim DecimalPortion As String
Dim Table As Worksheet

For Each Table In ActiveWorkbook.Worksheets

I = 3

Do While Format(Cells(I, 1)) <> ""

    J = 1
    F = Format(Cells(2, 1))
    
    Do While F <> ""

    AN = Left(F, 1)
    L = Val(Right(F, Len(F) - InStr(F, "-")))
    M = (L - Round(L, 0)) * 10
    
        Select Case AN
        Case "N"
            K1 = Format(Cells(I, J), String(L, "0"))
            If Len(K1) > L Then K1 = Left(K1, L)
            If K1 = "" Then K1 = String(L, "0")
        Case "D"
            IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
            DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0"))
            DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
            K1 = IntegerPortion & DecimalPortion
            If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), "0")  _
+ K1
            If K1 = "" Then K1 = String(L + M, "0")
        Case "A"
            K1 = Format(Cells(I, J))
            If Len(K1) > L Then K1 = Left(K1, L) Else K1 = K1 + Space(L - (Len(K1)))
            If K1 = "" Then K1 = Space(L)
        Case "S"
            IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
            DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0"))
            DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
            K1 = IntegerPortion & DecimalPortion
            If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), "0")  _
+ K1
            If Cells(I, J) < 0 Then K1 = K1 & "-" Else K1 = K1 & " "
            If K1 = "" Then K1 = String(L + M + 1, "0")
        End Select
        
        K = K & K1
        
        J = J + 1
        F = Format(Cells(2, J))
    Loop
    K = K & Chr(10)
    I = I + 1
Loop

fn = "c:\my documents\" & Sheets(1).Name
Open fn For Output Shared As #1
Print #1, K
Close #1

Next Table

End Sub



Ich denke die Schleife ist OK und das Problem liegt in der Benennung der Datei: "fn = "c:\my documents\" & Sheets(1).Name". Ist meine Einschaetzung richtig und wie sollte die Namensvergabe richtigerweise aussehen?


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Erich G.
Geschrieben am: 26.11.2007 18:37:52

Hallo Andrea,
verwende anstelle von Sheets(1).Name jetzt Table.Name

Noch ein Tipp: Table könnte ein geschütztes Wort sein.
Üblich wäre statt Table z. B wks als Variablenname für ein Worksheet.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Andrea
Geschrieben am: 26.11.2007 18:52:50

Ich erhalte jetzt zwar mehrer Dateien (in diesem speziellen Fall zwei), allerdings ist Datei 2 zwei identisch zu Datei 1 (gleicher Inhalt), mit dem Unterschied, dass die Daten in Datei 2 verdoppelt wurden (meine Arbeitsblaetter enthaletn garantiert unterschiedliche Daten). Im Augenblick ist also Datei 2 = 2 x Datei 1.
Hat das irgendwas mit meiner Schleife zu tun?

Danke nochmals, dass Ihr euch die Zeit nehmt.


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Erich G.
Geschrieben am: 26.11.2007 19:14:41

Hallo Andrea,
die Prozedur bearbeitet immer nur das zufällig gerade aktive Blatt.

Einfache, aber nicht so schöne Möglichkeit:
Hinter der Zeile
For Each Table In ActiveWorkbook.Worksheets
fügst du eine neue Zeile ein:
Table.Activate

Dann sollte es gehen.

Schöner/besser wäre das Arbeiten mit "With Table" und am Ende "End With".
Dann müsstest du aber bei allen Zugriffen (mit Cells(..)) einen Punkt vor Cells setzen.
Schau mal in die Hilfe zu With, falls du das nicht kennst. Es lohnt sich auf jeden Fall!

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Andrea
Geschrieben am: 26.11.2007 19:30:48

Ich habe mich fuer die enfachere Moeglichkeit entschieden (fuer's erste). Das Ergebnis sieht jetzt wie folgt aus: 2 Dateien :-); Datei 2 = Datei1 + Datei2 :-(. Irgendwie rutschen die Daten aus dem ersten Arbeitsblatt mit in Datei 2. Der Code sieht jetzt wie folgt aus:

Sub Gateway()
   
   Dim K As String
   Dim I As Integer
   Dim J As Integer
   Dim F As String
   Dim AN As String
   Dim L As Double
   Dim M As Integer
   Dim fn As String
   Dim K1 As String
   Dim IntegerPortion As String
   Dim DecimalPortion As String
   Dim Wks As Worksheet
   
   For Each Wks In ActiveWorkbook.Worksheets
   
   Wks.Activate
   
   I = 3
   
   Do While Format(Cells(I, 1)) <> ""
   
       J = 1
       F = Format(Cells(2, 1))
       
       Do While F <> ""
   
       AN = Left(F, 1)
       L = Val(Right(F, Len(F) - InStr(F, "-")))
       M = (L - Round(L, 0)) * 10
       
           Select Case AN
           Case "N"
               K1 = Format(Cells(I, J), String(L, "0"))
               If Len(K1) > L Then K1 = Left(K1, L)
               If K1 = "" Then K1 = String(L, "0")
           Case "D"
               IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
               DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0")) _

               DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
               K1 = IntegerPortion & DecimalPortion
               If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), " _
0") _
   + K1
               If K1 = "" Then K1 = String(L + M, "0")
           Case "A"
               K1 = Format(Cells(I, J))
               If Len(K1) > L Then K1 = Left(K1, L) Else K1 = K1 + Space(L - (Len(K1)))
               If K1 = "" Then K1 = Space(L)
           Case "S"
               IntegerPortion = Format(Int(Abs(Cells(I, J))), String(L, "0"))
               DecimalPortion = Format(Abs(Cells(I, J)) - IntegerPortion, "0." & String(M, "0")) _

               DecimalPortion = Right(DecimalPortion, Len(DecimalPortion) - 2)
               K1 = IntegerPortion & DecimalPortion
               If Len(K1) > L + M Then K1 = Left(K1, L + M) Else K1 = String(L + M - Len(K1), " _
0") _
   + K1
               If Cells(I, J) < 0 Then K1 = K1 & "-" Else K1 = K1 & " "
               If K1 = "" Then K1 = String(L + M + 1, "0")
           End Select
           
           K = K & K1
           
           J = J + 1
           F = Format(Cells(2, J))
       Loop
       K = K & Chr(10)
       I = I + 1
   Loop
   
   fn = "c:\my documents\" & Wks.Name
   Open fn For Output Shared As #1
   Print #1, K
   Close #1
   
   Next Wks
   
   End Sub




  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Erich G.
Geschrieben am: 26.11.2007 20:15:06

Hallo Andrea,
wie heißen die Blätter in deiner Mappe? Sollen die erzeugten Dateien eine Endung (wie .txt) bekommen?

Probier mal in deiner Mappe

Sub GatewayT()
   
   Dim K As String
   Dim Wks As Worksheet
   
   For Each Wks In ActiveWorkbook.Worksheets
      Wks.Activate
   
      K = Wks.Name
   
      fn = "c:\my documents\" & Wks.Name ' & ".txt" ' falls gewollt
      Open fn For Output Shared As #1
      Print #1, K

      Close #1

   Next Wks
End Sub

Die Belegung von K in der Loop-Schleife habe ich nicht nachvollzogen, das geht ohne deine Daten vermutlich nicht.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Erich G.
Geschrieben am: 26.11.2007 20:23:55

Hallo Andrea,
sorry, in meiner Kurzfassung fehlt
Dim fn As String

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Prozedur über mehrere Arbeitsblaetter von: Erich G.
Geschrieben am: 26.11.2007 20:27:46

Hallo nochmal,
jetzt habe ich einen Fehler gefunden:

Vor Next Wks fehlt noch ein
K = ""

Sonst bleibt der Inhalt von K erhalten und K wird immer länger...

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


 

Beiträge aus den Excel-Beispielen zum Thema "Prozedur fuer mehrere Arbeitsblaetter wiederholen"