Microsoft Excel

Herbers Excel/VBA-Archiv

Schleife bitte einbauen | Herbers Excel-Forum


Betrifft: Schleife bitte einbauen von: Bernd
Geschrieben am: 24.01.2012 21:55:10

Hallo Freaks,
ich bitte um Eure Ergänzung:
folgendes soll mit dem Code realisert werden: es gibt zwei Scheifen: die eine soll die 19 Kostenstellen, die in Range C53-C77 stehen, nacheinander abarbeiten und jeweils in Blatt 1 ("CTA") in die Zelle B5 schreiben.
Zu jeder Kostenstelle gibt es 14 sogenannte Cluster, die innerhalb der vorgenannen ersten Kostenstellen-Schleife nacheinander abgearbeitet werden müssen. Diese Cluster stehen in dem Zellbereich F53:F71 und müssen in die Zelle G5 (Blatt "CTA")geschrieben werden.
Ist das erfolgt, kommt die zweite Kostenstelle dran - wieder nacheinander mit den gleichen 14 Clustern usw. bis die 19 KST abgearbeitet sind.

Der nachfolgende Code aktualisert nicht die Kostenstelle....(also Schleife 1)... Danke Euch!! Ich habe versucht, ihn für Euch gut lesbar zu strukturieren.

Sub CTA_Automatisch_Aktualisieren_und_Speichern()
    
    Dim Bereich As Range
    Dim Zelle As Range
    Dim MerkWert As String
    Dim KST As Range
    Dim Zelle1 As Range
    
    Sheets("CTA").Activate
    Set KST = Range("F53:F71")         'Liste der zu bearbeitenden KST
    Set Bereich = Range("C53:C77")  'Liste der zu bearbeitenden Cluster
    
'es folgt die erste Schleife, um die erste KST (von 19 Kostenstellen) mit den Werten aus der  _
Range C53:C77 nacheinander in die Zelle 'Zelle B5 in Blatt CTA zu schreiben: 

  With Application  
  KST = Range("B5").Value
  For Each Zelle1 In Bereich

'es folgt die zweite Schleife innerhalb der ersten Schleife, um die Cluster mit der KST( _
Kostenstellen) mit den Werten aus der Range C53:C77 nacheinander in die Zelle 'Zelle B5 in Blatt CTA zu schreiben:

                   With Application
                   MerkWert = Range("G5").Value
                  .ScreenUpdating = True
                  .EnableEvents = False
                  .DisplayAlerts = False
                
                    For Each Zelle In Bereich
                    Range("G5").Value = Zelle.Value
                    
'bestehende Blätter aus dem Master/Vorlage kopieren und separat mit Cluster-Name aus Zelle  G5  _
abspeichern
                    Sheets(Array("CTA", "Entities", "Partner", "GIGGs_AREn")).Copy
                                                 
                      With ActiveWorkbook
                     .SaveAs ("P:\ALL CTA Templates\" & Zelle.Text & ".xls"), FileFormat:=56
                     .Close False          'verhindert, dass der Master geschlossen wird.
                      End With
                                               
                         Next Zelle
                            Range("G5").Value = MerkWert
                              .EnableEvents = True
                              .DisplayAlerts = True
                              .ScreenUpdating = True
                             End With  'Ende Schleife 2

  ' gehört zu Schleife 1
       Next Zelle1
            Range("B5").Value = KST
             .EnableEvents = True
      End With   'Ende Schleife 1


End Sub

---

Grüße
bernd

  

Betrifft: AW: Schleife bitte einbauen von: fcs
Geschrieben am: 25.01.2012 22:50:20

Hallo Bernd,

strukturierter Code sieht etwas anders aus als dein obiger Versuch.
Warum folgst du bei der Schachtelung/Logik der Schleifen nicht deiner Beschreibung?
Die angegebenen Zellbereiche für KST und Cluster passen nicht zu der angegebenen Anzahl für KST bzw. Cluster.

In die Dateinamen muss du auch die KST einbauen, sonst werden die Dateien mit Clusterwert immer wieder überschrieben.

So wie du deine Prozedur geschrieben hast stehen die beiden Zellbereiche mit KST und Cluster im Blatt "CTA". Ist das korrekt?

Gruß
Franz


Nach meiner Einschätzung müsste dein Makro etwa wie folgt aussehen:

Sub CTA_Automatisch_Aktualisieren_und_Speichern()
    
  Dim Bereich As Range
  Dim Zelle As Range
  Dim MerkWert As String
  Dim MerkKST As Variant
  Dim KST As Range
  Dim Zelle1 As Range
  
  Sheets("CTA").Activate
  Set KST = Range("C53:C71")         'Liste der zu bearbeitenden KST     - Bereich prüfen!!!
  Set Bereich = Range("F53:F66")     'Liste der zu bearbeitenden Cluster  - Bereich prüfen!!!
  

  With Application
    .ScreenUpdating = True
    .EnableEvents = False
    .DisplayAlerts = False
  End With
  
  MerkKST = Range("B5").Value
'es folgt die erste Schleife, um die KST (von 19 Kostenstellen) mit den Werten aus der _
Range C53:C71 nacheinander in die Zelle 'Zelle B5 in Blatt CTA zu schreiben:
  For Each Zelle1 In KST
      Range("B5").Value = Zelle1.Value

'es folgt die zweite Schleife innerhalb der ersten Schleife, um die Cluster mit der KST( _
Kostenstellen) mit den Werten aus der Range F53:F66 nacheinander in die Zelle 'Zelle G5 in  _
Blatt CTA zu schreiben:

      MerkWert = Range("G5").Value
              
      For Each Zelle In Bereich
          Range("G5").Value = Zelle.Value
                  
'bestehende Blätter aus dem Master/Vorlage kopieren und separat mit Cluster-Name aus Zelle  G5  _
_
abspeichern
          Sheets(Array("CTA", "Entities", "Partner", "GIGGs_AREn")).Copy
                                               
          With ActiveWorkbook
            .SaveAs ("P:\ALL CTA Templates\" _
                  & Zelle1.Text & "_" & Zelle.Text & ".xls"), FileFormat:=56
            .Close False          'verhindert, dass der Master geschlossen wird.
          End With
                                             
      Next Zelle 'Ende Schleife 2
      ' gehört zu Schleife 1
      Range("G5").Value = MerkWert
    

  Next Zelle1 'Ende Schleife 1
  Range("B5").Value = MerkKST
  With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
  End With


End Sub



  

Betrifft: @Franz von: Bernd
Geschrieben am: 28.01.2012 19:36:08

Hallo Franz,
super und tausend Dank, auch für die Erläuterung. Ich habe mir meine Fehler intensiv angesehen und hoffe, etwas aus Deinen Erläuterungen und deinem Code dauerhaft lernen zu können.

Grüße Bernd


Beiträge aus den Excel-Beispielen zum Thema "Schleife bitte einbauen"