Funktion per Macro Ändern

[MICA]

Wer kann mir helfen?

Habe in 100 Tabellen in jeweils 200 Feldern unten angegebene Formel (ALT)

Da ich faul bin, möchte ich diese nicht manuell ändern.

ALT
=WENN(RK!J5>0;SVERWEIS(A:A;RK!A:P;15;0);0)
NEU
=WENNFEHLER(WENN(RK!J5>0;SVERWEIS(A:A;RK!A:P;15;0);0);0)

Habe das schon mit dem Macro Editor probiert aber da ist nur Quark herausgekommen.

Über eine Hilfe wäre ich dankbar. Mach jetzt schon 1/2 Tag dran rum!

[Steffl]

Hallo,

mal ungetestet (bitte an einer Kopie testen!!!)

Code:

Sub prcFormelaendern()
    Dim wksSheet As Worksheet
    Dim rngZelle As Range
    
    For Each wksSheet In ThisWorkbook.Worksheets
        For Each rngZelle In wksSheet.Cells.SpecialCells(xlCellTypeFormulas)
            rngZelle.FormulaLocal = "=wennfehler(" & Mid(rngZelle.FormulaLocal, 2) & ";0)"
        Next rngZelle
    Next wksSheet
End Sub

[MICA]

Hallo Steffl,

vielen Dank für die schnelle Antwort !!!
Wie es im richtigen Leben immer so ist:
Dein Beispiel zeigt prima, wie ich in einem Rutsch alle Tabellen ändern könnte.
Was ich verschwiegen habe:
Die einzelnen Tabellenblätter sind gesperrt. :20:
Was schon klar ist, dass ich alle Excel Dateien manuell öffenen und das entsprechende Tabellenblatt manuell entsperren muss.
Es betrifft in der Datei auch nur ein Tabellenblatt mit den Feldern -> Range("G28:G288").Select <-
Nach dem Entsperren benötige ich ein Macro, dass die zu ändernden Felder markiert (s.o.) und danach die Funktion in den 200 betroffenen Felder ändert.
Sorry, dass ich nicht gleich die ganze Wahrheit gesagt habe.
Wie du schon merkst, habe ich wenig bis keine Erfahrung in VBA, deshalb auch der Hilferuf.
LG Carsten

[Steffl]

Hallo Carsten,

sind alle Tabellenblätter gesperrt oder nur eins? Befinden sich die zu ändernden Formeln nur im Bereich G28:G288? Du sprichst jetzt von Exceldateien. Bisher ging ich davon aus, das Du sehr viele Tabellenblätter in einer Datei hast. Lag ich da falsch?

[MICA]

Hallo Stefan,
erstmal vielen Dank, dass du dich um mein Problem kümmerst!!!!!
Zu Deinen Fragen:
Ich habe 100 Excel Dateien in denen das beschriebene Tabellenblatt gesperrt ist.
(das ist immer ein Datenblatt das als Druckvorlage dient mit dem genannten SVERWEIS in andere Tabellenblätter in der Spalte - Range("G28:G288"))
Musste dieses Datenblatt sperren, damit mein Anwender die Druckvorlage nicht putt macht.
Es sind also 100 Dateien mit jeweils einem Tabellenblatt in dem die Formel in 200 Feldern ausgetauscht werden muss.
Ohne die WENNFEHLER Funktion wird #NV in dem Feld ausgegeben und die Druckvorlage kann nicht erstellt werden. (Der SVERWEIS bringt kein Ergebnis, deshalb #NV)
(Ich blende vor dem Druck alle Zeilen aus die nicht gedruckt werden sollen (Leerzeilen)).
Da nun das #NV in einigen Zeilen drin ist, knallt mein Ausblend-Macro mit Laufzeitfehler. Wenn ich die Funktion WENNFEHLER einbaue, gibt es kein #NV und das automatische ausblenden funzt super.
Ich stelle mir nun vor, dass ich das Tabellenblatt aufrufe, dieses entsperre und mit einem wie immer gearteten Macro die Funktion mit WENNFEHLER optimiere. Danach wieder sperren usw. Das muss dann 100 mal gemacht werden.
Hoffe das war verständlich genug. Wenn jetzt noch eine Unklarheit bestehen, antworte ich gerne !!!:98:
Bin gespannt was dir dazu einfällt.
VG Carsten

[Steffl]

Hallo Carsten,

könntest Du den Code mal testen? (bitte an den betreffenden Positionen auf deine tatsächlichen anpassen)

Code:

Sub prcFormelaendern()
   Dim wkbDatei As Workbook
   Dim rngZelle As Range
   Dim strPfad As String, strDatei As String
  
  
   'der Pfad wo die Dateien gespeichert sind, bitte auf dem tatsächlichen anpassen
   strPfad = "C:\Users\Stefan\Documents\"
   'nur Dateien mit der Extention .xls
   strDatei = Dir(strPfad & "*.xls")
   Do While strDatei <> ""
      'die Dateien öffnen
      Set wkbDatei = Workbooks.Open(strDatei)
      With wkbDatei.Worksheets(1)
         'den Tabellenschutz entfernen
         .Unprotect Password:="DeinPasswort" 'bitte mit dem tatsächlichen ersetzen
         For Each rngZelle In .Range("G28:G288")
            'die Formel erweitern
            rngZelle.FormulaLocal = "=wennfehler(" & Mid(rngZelle.FormulaLocal, 2) & ";0)"
         Next rngZelle
         'das Tabellenblatt wieder schützen
         .Protect Password:="DeinPasswort"
      End With
      'die Datei speichern und schließen
      wkbDatei.Close savechanges:=True
   'die nächste Datei in dem Verzeichnis
   Loop
End Sub

[Steffl]

Hallo Carsten,

Da nun das #NV in einigen Zeilen drin ist, knallt mein Ausblend-Macro mit Laufzeitfehler.

vielleicht könntest Du hier auch das Ausblend-Macro posten, vielleicht ließe sich dieses auch umbauen, damit es nicht mit einem Laufzeitfehler aussteigt.

[MICA]

Moin Steffen
dein Macro zur Änderung der Funktion hat mich umgehauen!
Die Teilstatements funktionieren recht gut.
Was leider nicht geht ist, dass die gefundene Datei geöffnet wird.
Mit strDatei = Dir(strPfad & "*.xlsm") bekomme ich in der Variablen nur die erste Datei (1.xlsm)
Diese läßt sich aber nicht öffen
Laufzeitfehler '1004' --> 1.xlsm wurde nicht gefunden
'die Dateien öffnen
Set wkbDatei = Workbooks.Open(strDatei)
With wkbDatei.Worksheets(5)

Habe Dein Super Macro noch an meine Bedürfnisse angepaßt:

Code:

Sub prcFormelaendernCL()
   Dim wkbDatei As Workbook
   Dim rngZelle As Range
   Dim strPfad As String, strDatei As String
    
'der Pfad wo die Dateien gespeichert sind, bitte auf dem tatsächlichen anpassen
   strPfad = "C:\Users\Carsten Lippold\Projekte\"
'nur Dateien mit der Extention .xlsm
   strDatei = Dir(strPfad & "*.xlsm")
   MsgBox strPfad
   MsgBox strDatei      -->  ES WIRD NUR EINE DATEI ANGEZEIGT, OBWOHL IM TESTVERZ. 4 DATEIEN EXISTIEREN
   Do While strDatei <> ""
'die Dateien öffnen   --->  HIER KOMMT DER LAUFZEITFEHLER
      Set wkbDatei = Workbooks.Open(strDatei)
      With wkbDatei.Worksheets(5)
'den Tabellenschutz entfernen
         .Unprotect Password:="x" 'bitte mit dem tatsächlichen ersetzen
         For Each rngZelle In .Range("G28:G288")
'die Formel erweitern
            rngZelle.FormulaLocal = "=wennfehler(" & Mid(rngZelle.FormulaLocal, 2) & ";0)"
         Next rngZelle
'das Tabellenblatt wieder schützen
         .Protect Password:="x"
      End With
'die Datei speichern und schließen
      wkbDatei.Close savechanges:=True
'die nächste Datei in dem Verzeichnis
    MsgBox ("Datei")
   Loop

Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
"End Sub" fehlt!
Moderator [Bild: smilie.php?smile_ID=1810]

[MICA]

Hier das Ausblend-Macro
Das Statement If cellContent = 0 bringt den Fehler!

Code:

Sub AusblendenA()
'
'   Ausblenden Produkte mit Wert = 0
'
    fromRow = 27
    toRow = 29
    intCounter1 = 1
'
'   Schleife bis alles ausgeblendet ist
'
    Do Until intCounter1 = 21
    cellContent = ActiveSheet.Range("N" & fromRow).Value
'
    If cellContent = 0 Then
        Rows(fromRow & ":" & toRow).Select
        Selection.EntireRow.Hidden = True
    End If
'
    fromRow = fromRow + 3
    toRow = toRow + 3
    intCounter1 = intCounter1 + 1
'
   Loop

End Sub

Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
Moderator [Bild: smilie.php?smile_ID=1810]

[Steffl]

Hallo Carsten,

ich habe mal dein Makro umgeschrieben, Variablen deklariert, das unnötige Select entfernt und die If-Bedingung geändert, wobei ich davon ausging, das auch die Zeilen mit dem Fehler ausgeblendet werden sollen.

Code:

'Hier das Ausblend-Macro
' Das Statement If cellContent = 0 bringt den Fehler!

Sub AusblendenA()
   '
   ' Ausblenden Produkte mit Wert = 0
   '
   Dim fromRow As Long, toRow As Long, intcounter1 As Long
  
   fromRow = 27
   toRow = 29
   intcounter1 = 1
   '
   ' Schleife bis alles ausgeblendet ist
   '
   Do Until intcounter1 = 21
      cellContent = ActiveSheet.Range("N" & fromRow).Value
      '
      If Not IsError(cellContent) Then
         If cellContent = 0 Then Rows(fromRow & ":" & toRow).Hidden = True
      Else
         Rows(fromRow & ":" & toRow).Hidden = True
      End If
      '
      fromRow = fromRow + 3
      toRow = toRow + 3
      intcounter1 = intcounter1 + 1
      '
   Loop

End Sub