hilfe beim vba code

folgenden code habe ich zusammengebastelt. er funktioniert auch nur möchte dass sich die column befehlszeile immer dann um 1 erhöht wenn ich in der msgbox auf ja klicke

Private Sub Worksheet_Activate()

If Tabelle7.Range("B2").Value > "" Then
Dim Antwort As Integer
Antwort = MsgBox("Möchtest du das Ergebnis der Formeln auf Übersicht Ausgaben und Diagramm speichern ?", vbYesNoCancel + vbQuestion + vbDefaultButton2, "Frage")

If Antwort = vbYes Then
GoTo 1:
Else
GoTo 2:
End If
1:
anfang: Dim rngBereich As Range, iCalc As Integer

'Bereich wo sich die Formeln befinden, hier Spalte 1
Set rngBereich = Columns(3) diese 3 soll sich immer um 1 erhöhen wenn ich in der msgbox auf ja klicke.
On Error GoTo KeineFormeln:
'sind keine Formeln vorhanden, kommt es zum Fehler
Set rngBereich = rngBereich.SpecialCells(xlCellTypeFormulas)
On Error GoTo anfang:

With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual

' Formel wird durch festen Wert ersetzt,
' wenn diese als Ergebnis nicht leer liefert.
' Dies kann auch umgestellt oder erweitert werden
For Each rngBereich In rngBereich
If rngBereich > "" Then rngBereich.Value = rngBereich.Value
Next rngBereich

.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With

KeineFormeln:

End If

2:
End Sub

Bitte um Hilfe !!!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Kann als abschreckendes Beispiel dienen

11.02.2024 11:11:20

Oppawinni

AW: hilfe beim vba code

11.02.2024 12:07:38

Herbert Grom

AW: hilfe beim vba code

11.02.2024 15:00:38

Oppawinni

AW: hilfe beim vba code

11.02.2024 18:06:23

Oberschlumpf

AW: hilfe beim vba code

11.02.2024 19:49:39

Oppawinni

AW: Denke groß

11.02.2024 12:50:29

Sulprobil

AW: hilfe beim vba code

11.02.2024 19:38:59

Andreas Schmitt

AW: hilfe beim vba code

11.02.2024 21:52:05

Piet

AW: Sorry, ich bin raus!! oWt

12.02.2024 01:20:59

Piet

Thema erledigt

12.02.2024 10:51:03

Oppawinni

AW: hilfe beim vba code

11.02.2024 23:14:14

Andreas Schmitt

AW: hilfe beim vba code

12.02.2024 01:05:09

Oppawinni

AW: hilfe beim vba code

11.02.2024 20:14:12

Oppawinni

AW: hilfe beim vba code

11.02.2024 20:36:04

Andreas Schmitt

AW: hilfe beim vba code

11.02.2024 20:52:10

Oppawinni

AW: Was Piet meinte war wohl

11.02.2024 21:49:44

Oppawinni

AW: Denke groß

11.02.2024 13:59:02

Piet

Mehrfach Post

11.02.2024 14:48:19

Oppawinni

Option Explicit Private Sub Worksheet_Activate() Dim Antwort As Integer Dim rngBereich As Range, iCalc As Integer, lCol& lCol = 3 If Tabelle7.Range("B2").Value > "" Then Antwort = MsgBox("Möchtest du das Ergebnis der Formeln auf Übersicht" & vbLf & _ "Ausgaben und Diagramm speichern ?", vbYesNoCancel + vbQuestion + vbDefaultButton2, "Frage") If Antwort = vbYes Then lCol = lCol + 1 If Antwort = vbNo Then GoTo ende anfang: 'Bereich wo sich die Formeln befinden, hier Spalte 1 Set rngBereich = Columns(lCol) 'sind keine Formeln vorhanden, kommt es zum Fehler Set rngBereich = rngBereich.SpecialCells(xlCellTypeFormulas) On Error GoTo anfang With Application iCalc = .Calculation .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual ' Formel wird durch festen Wert ersetzt, ' wenn diese als Ergebnis nicht leer liefert. ' Dies kann auch umgestellt oder erweitert werden For Each rngBereich In rngBereich If rngBereich > "" Then rngBereich.Value = rngBereich.Value Next rngBereich .Calculation = iCalc .ScreenUpdating = True .EnableEvents = True End With End If ende: End Sub

Sub Spalten_inWerte_wandeln() Dim Antwort As Integer, s, lsp As Long If ActiveSheet.Name = "Tabelle3" Then 'LastSpalte in Zeile 1 suchen lsp = Cells(1, Columns.Count).End(xlToLeft).Column s = 3 '1. Columne in Tabelle3 Do Until s > lsp 'Wiederholen bis LastSpalte On Error Resume Next Set rngBereich = Columns(s).SpecialCells(xlCellTypeFormulas) Columns(s).Select '** Select nur für optische Kontrolle If Err = 0 Then Antwort = MsgBox("Möchtest du das Ergebnis der Formeln als Werte speichern ?" & _ vbLf & "gewählter Bereich: Spalte " & s & " " & rngBereich.Address(0, 0), vbYesNoCancel + vbQuestion + vbDefaultButton2, "Frage") If Antwort = vbCancel Then Exit Sub 'Programm Ende!! If Antwort = vbYes Then rngBereich.Value = rngBereich.Value End If Err.Clear: s = s + 1 'Next Spalte Loop End If End Sub

Nur damit hier nicht noch ein paar Threads mit diesem Thema geöffnet werden.
Es ging darum, eine Zähler zu haben, der bei jedem Aufruf des Makros, falls die MsgBox bestätigt wird, also Formeln durch Werte ersetzt werden, hochgezählt wird.
Der Wert muss natürlich ggf. irgendwo außerhalb des Macros gespeichert werden.
Da gibt es mehrere Möglichkeiten. Man könnte dafür z.B. eine Zelle nehmen, die hinter dem Diagramm liegt Tabelle4.Range("E22"):
Leider nicht ganz der Code des TO, um bei mir den Brechreiz zu vermeiden. TaTaa TaTaa TaTaaaaa



Private Sub Worksheet_Activate()



Dim rngToCheck As Range

Dim rngCounter As Range

Dim lngCounter As Long



'Variable für einfachere Pflege des Codes

Set rngToCheck = Tabelle7.Range("B2")   'Nur wenn diese Zelle nicht "" ist, soll das Macro etwas tun

Set rngCounter = ActiveSheet.Range("E22")   'Zählerzelle versteckt hinter dem Diagramm



Const cMinCounter = 3   'Minimaler Wert des Zählers

Const cMaxCounter = 8   'Maximaler Wert des Zählers



'Zähler ggf. initalisieren

If IsEmpty(rngCounter) Then rngCounter = cMinCounter

'Zählerwert holen

lngCounter = rngCounter.Value



If rngToCheck = "" Then

    Exit Sub

End If



Dim lngAntwort As Long



lngAntwort = MsgBox("Möchtest du die Ergebnisse der Formeln der Spalte " & lngCounter & " speichern ?", vbYesNoCancel + vbQuestion, "Frage")



If Not lngAntwort = vbYes Then

    Exit Sub

End If



Dim rngBereich As Range

Dim rngCell As Range

Dim iCalc As Integer

'Zählerwert für den nächsten Durchlauf setzen

If rngCounter.Value = cMaxCounter Then

    rngCounter.Value = rngCounter.Value + 1

Else

    rngCounter.Value = cMinCounter

End If



With Application

    iCalc = .Calculation

    .ScreenUpdating = False

    .EnableEvents = False

    .Calculation = xlCalculationManual

End With



'Bereich wo sich die Formeln befinden, hier Spalte 1

Set rngBereich = ActiveSheet.Columns(lngCounter) 'diese Spalte soll sich bei jedem Aufruf des Macros um 1 erhöhen wenn in der msgbox "ja" gewählt wird.

On Error Resume Next

Set rngBereich = rngBereich.SpecialCells(xlCellTypeFormulas)

If Err = 0 Then

    ' Formel wird durch festen Wert ersetzt,

    ' wenn diese als Ergebnis nicht leer liefert.

    ' Dies kann auch umgestellt oder erweitert werden

    For Each rngCell In rngBereich

        If rngCell > "" Then rngCell = rngCell.Value

    Next

End If



With Application

    .Calculation = iCalc

    .ScreenUpdating = True

    .EnableEvents = True

End With



End Sub

Private Sub Worksheet_Activate() If Tabelle7.Range("B2").Value = "" Then Exit Sub End If Dim Antwort As Integer Antwort = MsgBox("Möchtest du das Ergebnis der Formeln auf Übersicht Ausgaben und Diagramm speichern ?", vbYesNoCancel + vbQuestion + vbDefaultButton2, "Frage") If Antwort > vbYes Then Exit Sub End If Dim rngBereich As Range Dim rngResult As Range Dim rngCell As Range Dim lngCol As Long Dim iCalc As Integer With Application iCalc = .Calculation .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With lngCol = 3 anfang: 'Bereich wo sich die Formeln befinden, hier Spalte 1 Set rngBereich = Columns(lngCol) 'diese 3 soll sich immer um 1 erhöhen wenn ich in der msgbox auf ja klicke. lngCol = lngCol + 1 On Error GoTo KeineFormeln: 'sind keine Formeln vorhanden, kommt es zum Fehler Set rngResult = rngBereich.SpecialCells(xlCellTypeFormulas) On Error GoTo anfang: ' Formel wird durch festen Wert ersetzt, ' wenn diese als Ergebnis nicht leer liefert. ' Dies kann auch umgestellt oder erweitert werden For Each rngCell In rngResult If rngCell > "" Then rngCell = rngCell.Value Next KeineFormeln: With Application .Calculation = iCalc .ScreenUpdating = True .EnableEvents = True End With End Sub

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

hilfe beim vba code

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread