Hilfe bei Code

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

Betrifft: Hilfe bei Code
von: anna
Geschrieben am: 13.08.2015 16:06:16

Guten Tag zusammen,
ich habe einen Code gebastelt der leider noch nicht ganz funktioniert und auch noch ein wenig gekürzt werden soll (MsgBox).
Im Code selbst habe ich auch geschrieben was passieren soll.
Erstmal der Code:

Public Sub FormelnAnpassen()
Dim wks As Worksheet
Dim z As Range
Dim strSB As String, alteFormel As String, neueFormel As String
Dim intFarbe As Integer, intAnt As Integer
Dim q
 
  
''''''''''''''''''''''' Schleife von Anfang'''''''''''''''''
  Do
  
  q = 8
        
              With ActiveSheet
              
              dsumme = WorksheetFunction.Sum(.Range(.Cells(9, 3), .Cells(12, 3)))
              dsumme2 = WorksheetFunction.Sum(.Range(.Cells(14, 3), .Cells(15, 3)))
              
              End With
              
              
'''''''''''''''''''''Werte nacheinander einfügen'''''''''''''
              ActiveSheet.Cells(q + 1, 6) = dsumme
              ActiveSheet.Cells(q + 1, 7) = dsumme2
                  
        For Each wks In ThisWorkbook.Worksheets
          strSB = "C:\Beispiel\[test2.xlsx]" & wks.Index
          
          For Each z In wks.Range("c9:c15")
            If z.HasFormula = True And InStr(1, z.Formula, strSB) <> 0 Then
              wks.Activate
              z.Activate
                     
         
              alteFormel = z.Formula
              neueFormel = Replace(alteFormel, _
                                   "test2.xlsx]" & wks.Index, _
                                   "test2.xlsx]" & wks.Index + 1)
                                   
                       
        
''''''''''''''''''''''''''keine MsgBox'''''''''''''''''''''
        
        intAnt = MsgBox("soll die Formel in Zelle " & z.Address & " ersetzt werden?" _
                        & vbNewLine & vbNewLine _
                        & "alt:" & vbTab & alteFormel & vbNewLine _
                        & "neu:" & vbTab & neueFormel, vbYesNoCancel, "Formel ersetzen?")
          
        If intAnt = 6 Then z.Formula = neueFormel
        If intAnt = 2 Then Exit Sub
      End If
      
''''''''''''''Zellen aktualisieren'''''''''''''''''''
      
      Application.CalculateFullRebuild
      
    Next z
  Next wks
Loop
       
End Sub
1. Ich würde gern die Messagebox raus schmeißen. Das hab ich zwar schon paar mal versucht, aber dann funktioniert der Code nicht mehr bei mir.
2. Der ganze Code soll nun als Schleife durchlaufen werden.
3. Die Zellen ("c9:c15") sollen immer wieder aktualisiert werden, nachdem sie einmal durchlaufen wurden und dann kopiert werden.
4. Die aktualisierten Werte der Zellen sollen kopiert und eingefügt werden.
Danke schon mal im Voraus.
Einen schönen Tag
Anna

Bild

Betrifft: AW: Hilfe bei Code
von: selli
Geschrieben am: 13.08.2015 16:18:30
hallo anna,

Public Sub FormelnAnpassen()
Dim wks As Worksheet
Dim z As Range
Dim strSB As String, alteFormel As String, neueFormel As String
Dim intFarbe As Integer, intAnt As Integer
Dim q
 
  
''''''''''''''''''''''' Schleife von Anfang'''''''''''''''''
  Do
  
  q = 8
        
              With ActiveSheet
              
              dsumme = WorksheetFunction.Sum(.Range(.Cells(9, 3), .Cells(12, 3)))
              dsumme2 = WorksheetFunction.Sum(.Range(.Cells(14, 3), .Cells(15, 3)))
              
              End With
              
              
'''''''''''''''''''''Werte nacheinander einfügen'''''''''''''
              ActiveSheet.Cells(q + 1, 6) = dsumme
              ActiveSheet.Cells(q + 1, 7) = dsumme2
                  
        For Each wks In ThisWorkbook.Worksheets
          strSB = "C:\Beispiel\[test2.xlsx]" & wks.Index
          
          For Each z In wks.Range("c9:c15")
            If z.HasFormula = True And InStr(1, z.Formula, strSB) <> 0 Then
              wks.Activate
              z.Activate
                     
         
              alteFormel = z.Formula
              neueFormel = Replace(alteFormel, _
                                   "test2.xlsx]" & wks.Index, _
                                   "test2.xlsx]" & wks.Index + 1)
                                      
        z.Formula = neueFormel
        
      End If
      
''''''''''''''Zellen aktualisieren'''''''''''''''''''
      
      Application.CalculateFullRebuild
      
    Next z
  Next wks
Loop
       
End Sub

gruß
selli

Bild

Betrifft: AW: Hilfe bei Code
von: anna
Geschrieben am: 13.08.2015 16:47:19
Hi Selli,
danke, aber so ganz ist es das leider noch nicht.
Die Punkte 2-4 bestehen nach wie vor.
Ist für die Schleife evtl eine For each Kombination besser ?! Diese soll sich nämlich an der Anzahl der Tabellenblätter im anderen Arbeitsblatt orientieren.
Ich glaube auch, dass das gleiche Problem jetzt auftritt nachdem die MsgBox weg ist, wie ich zuvor schon hatte wenn ich sie raus genommen habe. wks.Index + 1 wird nicht mehr nach oben gezählt.
Wäre wirklich super wenn mir jemand helfen könnte.
Ist wirklich wichtig.
Danke schon mal im voraus.
Grüße
Anna

Bild

Betrifft: AW: Hilfe bei Code
von: selli
Geschrieben am: 13.08.2015 16:54:16
hallo anna,
ich habe auch nur dass verändert, was ich anhand deiner vorgaben hier (sprich makro) verändern konnte.
habe nur die msgbox rausgenommen.
deine datei nachzubauen, um zu sehen, wie sich daraufhin dein code auswirkt, ist wohl etwas viel verlangt.
gruß
selli

Bild

Betrifft: AW: Hilfe bei Code
von: anna
Geschrieben am: 13.08.2015 17:15:36
Hi Selli,
ok ich freu mich ja wenn ich keine sofort sichtbaren Fehler mehr mache.
Eine Beispieldatei musst du natürlich nicht bauen, da hab ich eine.
https://www.herber.de/bbs/user/99546.zip
https://www.herber.de/bbs/user/99547.xlsx
Die ...46 enthält das Makro und bezieht sich auf ....47.
Hoffe du kannst mir jetzt helfen :)
Vielen Dank
Anna

Bild

Betrifft: So?
von: Michael
Geschrieben am: 16.08.2015 13:26:46
Hi Anna,
versuch's mal damit:

Option Explicit
Function Blaetter(ByVal sFile As String) As Long
      If Dir(sFile) <> "" Then
         Workbooks.Open Filename:=sFile
         Blaetter = Worksheets.Count
         ActiveWorkbook.Close savechanges:=False
       Else: Blaetter = -1
      End If
End Function
Public Sub FormelnAnpassen()
Dim q&, i&, bis&
  
bis = Blaetter("C:\DeinPfad\DeineDatei.xlsx")
If bis > 0 Then
  q = 8
  For i = 1 To bis
    If i > 1 Then
      Cells.Replace What:="]" & i, Replacement:="]" & i + 1, LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End If
    Application.Calculate
    Cells(q + 1, 6) = WorksheetFunction.Sum(Range(Cells(9, 3), Cells(12, 3)))
    Cells(q + 1, 7) = WorksheetFunction.Sum(Range(Cells(14, 3), Cells(15, 3)))
    q = q + 1
  Next
  ' Nach Makro wieder auf 1 setzen
  Cells.Replace What:="]" & i, Replacement:="]1", LookAt:=xlPart, SearchOrder _
      :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Else
  MsgBox "Fehler mit Blättern in der Datei"
End If
End Sub

Der Punkt ist, daß Deine Datei, die das Makro enthält, ja gar nicht weiß, wieviele Blätter in der Datendatei vorhanden sind. Deshalb könnte Deine Schleife gar nicht funktionieren.
Der Königsweg wäre natürlich, die zweite Datei einfach zu öffnen, die Daten dort direkt zu ermitteln und hier reinzuschreiben, ohne den Umweg über die Formeln. Dazu kannst Du mal hier schnüffeln: https://www.herber.de/xlfaq/index.html
Ich habe Dein Makro etwas überarbeitet: Dank den schönen Blattnamen 1, 2 usw. genügt ein simples replace (wie in Excel Suchen+Ersetzen), mit dem nur die Ziffer nach dem "]" ersetzt wird.
Schöne Grüße,
Michael
P.S.: Der Sinn der Code-Einrückung ist, daß zusammengehörige Schlüsselwörter wie If .. end if und for ... next untereinander stehen, damit man sieht, was wo anfängt bzw. aufhört.

Bild

Betrifft: So? Noch nicht ganz
von: anna
Geschrieben am: 17.08.2015 11:55:54
Hi Michael,
danke für deinen tollen Ansatz und die Tipps.
Das über die Suchenfunktion abzudecken ist sehr schlau.
Die Berechnung gleich im Makro zu machen wäre natürlich klasse, dafür reicht aber zum einen mein Programmierungswissen nicht aus, zum anderen ist die Formel (nicht im Bsp.) sehr umfangreich. Aber ich übe weiter :)
Leider funktioniert der Code so noch nicht. Ich komm immer zu deiner eingebauten Fehlermeldung. Wobei ich mit Sicherheit den richtigen Pfad eingegeben habe, genauso wie sich auch mehrere Tabellenblätter in der anderen Bsp. Datei befinden die durchnummeriert sind.
Weist du woran das liegen kann?
Und eine andere Frage noch. Wenn der Code Standardmäßig das erste Tabellenblatt der anderen Datei berechnet, müssen dann nicht erst die Daten kopiert werden und dann diese verändert werden, dann wieder kopiert usw. ?
Danke
Schöne Grüße
Anna

Bild

Betrifft: AW: So? Doch :)
von: anna
Geschrieben am: 17.08.2015 13:15:00
ok jetzt hab ich es. war mein Fehler. lief alles schon sehr korrekt.
vielen dank :)
grüße
anna

Bild

Betrifft: AW: So? Doch :) freut mich, und...
von: Michael
Geschrieben am: 17.08.2015 14:39:55
Hi Anna,
freut mich, wenn es tut.
Naja, mit zwei offenen Datein zu hantieren ist auch keine Hexerei, aber wie aufwendig oder auch nicht das wegen Deinen (nicht im Beispiel vorhandenen) Formeln sein mag, kann ich so natürlich nicht beurteilen.
Ganz allgemein kann man es wahrscheinlich so gestalten, daß die Auswertung der externen Datei rein in VBA erfolgt, und nur die Ergebniswerte in die Hauptdatei geschrieben werden.
Aber wenn alles so läuft, wie es ist, und Du keine Performance-Probleme hast, wozu die Geschichte dann ändern?
Happy Exceling,
Michael

Bild

Betrifft: jetzt doch noch was ! :O
von: anna
Geschrieben am: 18.08.2015 17:01:49
Hi Michael,
jetzt muss ich doch nochmal nachfragen.
Es gibt zwei Dinge die ich gerne noch ändern würde.
1. Im Moment übergeht es mir das erste Tabellenblatt in der anderen Arbeitsmappe und fängt gleich mit dem zweiten an. Das erste Tabellenblatt wird erst auf Abfrage von Excel "auf welchen Wert zurück gesetzt werden soll" zum Schluss eingefügt.
Quasi soll der erste berechnete Wert aber sofort kopiert werden und im darauf folgenden Schritt die Formel verändert, neuberechnet, kopiert, usw werden.
2. Das nächste Problem was ich habe, was sich evtl jetzt durch das erste löst, ich kann das Makro nicht öfter laufen lassen. Wenn ich es einfüge funktioniert es einmal wunderbar, wenn ich es jetzt noch einmal laufen lasse funktioniert es aber nicht mehr. Das Makro kopiert mir dann immer die gleichen Werte von Tabellenblatt 1 in alle bereits gefüllten Zellen.
Meine Vermutung ist, dass die "das Makro wieder auf 1 setzen" Funktion das blockiert, da beim zweiten Durchlaufversuch nur Werte von Tabellenblatt eins ausgegeben werden.
Kannst du mir helfen die Herausforderung zu lösen :)
Viele Grüße
Anna

Bild

Betrifft: sorry, mein Fehler,
von: Michael
Geschrieben am: 18.08.2015 23:07:42
Anna,
da ist mir was durcheinandergekommen. Die Ersetzung der Nummern soll ja erst ab i=2 anfangen, damit zuerst mit 1 ausgewertet wird. Allerdings wird bei i=2 nicht die 1 durch die zwei ersetzt, da ich nach 2 suche - es passiert also rein gar nix, außer daß die immer gleichen Werte geschrieben werden.
Leider ist auch die Ersetzung ganz unten fehlerhaft, da Excel die seltsame Eigenschaft hat, Variablen nach einem Schleifendurchgang nochmal um 1 zu erhöhen, so daß i dann den Wert 10 hat - nach dem ] steht aber eine 9.
Hier ist bereits abzusehen, daß es doch nicht mehr funktioniert, sobald Du mehr 10 Blätter Daten hast: da wird nach 1 gesucht und 2 reingeschrieben, dann hast Du plötzlich nicht 11 statt 10, sondern 20.
Habe alles nochmal geändert, insbesondere das mit den Zeilen: gib bitte in Deiner Makro-Datei in Zelle G2 eine 8 ein, das holt sich das Makro, arbeitet 9 Blätter ab und schreibt dann eine 17 rein - so überschreiben sich die Werte nicht bei jedem Aufruf.
Also insgesamt so:

Function Blaetter(ByVal sFile As String, ByVal zeile As Long) As Long
Dim z&
      If Dir(sFile) <> "" Then
         Workbooks.Open Filename:=sFile
         Blaetter = ActiveWorkbook.Worksheets.Count
         For z = 1 To Blaetter
'          Ausgabe der Blattnamen in SpalteH unter Tab.Name
           ThisWorkbook.Sheets(1).Cells(zeile + z - 1, 8).Value = _
           ActiveWorkbook.Worksheets(z).Name
         Next
         ActiveWorkbook.Close savechanges:=False
       Else: Blaetter = -1
      End If
End Function
Public Sub FormelnAnpassen()
Dim q&, i&, bis&
  
q = Range("G2").Value + 1
bis = Blaetter("C:\DeinPfad\DeineDatei.xlsx", q)
If bis > 0 Then
  For i = 1 To bis
    If i > 1 Then
      Cells.Replace What:="]" & i - 1, Replacement:="]" & i, LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    End If
    Stop
    Application.Calculate
    Cells(q, 6) = WorksheetFunction.Sum(Range(Cells(9, 3), Cells(12, 3)))
    Cells(q, 7) = WorksheetFunction.Sum(Range(Cells(14, 3), Cells(15, 3)))
    Cells(q, 9) = i
'   Ausgabe von i Spalte I unter Var i
    q = q + 1
  Next
  ' Nach Makro wieder auf 1 setzen
  Cells.Replace What:="]" & bis, Replacement:="]1", LookAt:=xlPart, SearchOrder _
      :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  Range("G2").Value = q - 1
Else
  MsgBox "Fehler mit Blättern in der Datei"
End If
End Sub
Paß bitte auf, ich benutzt jetzt zusätzlich die Spalten H und I, um die Blattnummern auszugeben - falls das was Wichtiges steht, mußt Du die entsprechenden Zeilen im Code auskommentieren.
Happy Exceling,
Michael
P.S.: also doch mit direktem Öffnen und Auswerten, im Grunde ist es einfacher, da mit weniger Variablen hantiert wird:
Voraussetzung ist, daß die Datendatei geschlossen ist - oder noch abfragen
Sub ganzneu()
Dim q&, i&, bis&, summe#
Dim sFile$
q = Range("G2").Value + 1
sFile = "C:\DeinPfad\DeineDatei.xlsx"
If Dir(sFile) <> "" Then
   Workbooks.Open Filename:=sFile
   bis = ActiveWorkbook.Worksheets.Count
   For i = 1 To bis
     summe = 0
     summe = summe + WorksheetFunction.Sum(ActiveWorkbook.Sheets(i).Range("$A$1:$A$13"))
     summe = summe + WorksheetFunction.Sum(ActiveWorkbook.Sheets(i).Range("$B$6:$B$11"))
     ' usw., was Du halt benötigst
     ThisWorkbook.Sheets(1).Cells(q, 6).Value = summe
     summe = 0
     summe = summe + WorksheetFunction.Sum(ActiveWorkbook.Sheets(i).Range("$A$12:$A$17"))
     summe = summe + WorksheetFunction.Sum(ActiveWorkbook.Sheets(i).Range("$B$12:$B$20"))
     ' usw., was Du halt benötigst
 ' in Deiner Beispieldatei überschneiden sich einige Summen sowieso, paß auf!
     ThisWorkbook.Sheets(1).Cells(q, 7).Value = summe
     q = q + 1
   Next
   ActiveWorkbook.Close savechanges:=False
   Range("G2").Value = q - 1
 Else
   MsgBox "File not found"
End If
End Sub


Bild

Betrifft: fünf sterne lösung
von: anna
Geschrieben am: 19.08.2015 17:09:56
Hi Michael,
jetzt funktioniert alles wirklich perfekt.
vielen dank für deine zeit und hilfe. das hätte ich so nie hingekriegt.
viele grüße
anna

Bild

Betrifft: gerne, vielen Dank für Deine Freundlichkeit
von: Michael
Geschrieben am: 19.08.2015 20:12:13


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zählenwenns ohne Duplikate"