Code 100x laufen lassen und "Werte hochzählen"

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

Betrifft: Code 100x laufen lassen und "Werte hochzählen"
von: erichm
Geschrieben am: 04.09.2015 18:20:18

Hallo,
ich habe einen Code der funktioniert aber noch optimiert / automatisiert werden soll.
Ausgangsbasis:
Zelle A1 ist mit Wert 4933 belegt
Zelle A2 hat die Formel =A1
In den Spalten D bis K, ab Zeile 4934 bis 6033 sind Formeln eingetragen, die aber nach "Neu berechnen" von Zeile zu Zeile in Werte umgewandelt werden müssen.
Diesen Code müsste ich jetzt 1100x mal anstoßen; das kann man bestimmt mit einer Schleife oder so.

Sub hochzählen()
 Sheets("Testen").Select
 Cells(1, 1).Select ' in der Zelle steht die Zahl 4933
  If Cells(1, 1) > 0 Then
  Cells(1, 1).Value = Cells(2, 1) + 1 'in der Zelle Cells(2, 1) steht vor (!!!) Ausführung  _
ebenfalls 4933
   End If
   ' jetzt ist in Cells (1, 1) der Wert 4934
   
   'jetzt wird die Datei neu gerechnet
   Calculate
   
  ' nachstehende Range ist jetzt die Zeilennummer die in Cells(1, 1) steht = 4934
  ' diese erhöht sich jedesmal wenn der Code aktiviert wird
  ' aber wie kann ich den Wert aus Cells(1, 1) in die Range einbinden??
  
  
  Range("D4934:K4934").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    '---> dieses hochzählen soll jetzt 1100x mal passieren
    
End Sub
Anmerkung: ob beim hochzählen in Zelle A1 die Hilfe von Zelle A2 benötigt wird, weiß ich nicht sicher - aber mir ist kein anderer Code eingefallen.
Besten Dank für eine Hilfe.
mfg

Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: Sepp
Geschrieben am: 04.09.2015 20:38:46
Hallo Erich,
so?

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub hochzählen()
Dim lngI As Long


On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

With Sheets("Testen")
  For lngI = 4934 To 6033
    .Cells(1, 1) = lngI
    With .Range(.Cells(lngI, 4), .Cells(lngI, 11))
      .Calculate
      .Value = .Value
    End With
  Next
End With

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'hochzählen'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - hochzählen"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With


End Sub


Gruß Sepp


Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: erichm
Geschrieben am: 05.09.2015 06:58:59
Hallo Sepp,
noch nicht ganz richtig:
Derzeit wird die Range 4934 bis 6033 nach einem neuen Rechenvorgang von Formeln in Werte umgewandelt.
Es muss aber folgendes passieren:
1. Wert in A1 um 1 erhöhen
2. rechnen
3. Range mit dem neuen Wert aus A1 von Formeln in Werte umwandeln
dann wieder
A1 erhöhen usw....
Ich bringe diese Schleife nicht rein...
Besten Dank nochmal.
mfg

Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: Sepp
Geschrieben am: 05.09.2015 07:05:42
Hallo Erich,
dann so.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub hochzählen()
Dim lngI As Long

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlManual
  .DisplayAlerts = False
End With

With Sheets("Testen")
  For lngI = 4934 To 6033
    .Cells(1, 1) = lngI
    .Calculate
    With .Range(.Cells(lngI, 4), .Cells(lngI, 11))
      .Value = .Value
    End With
  Next
End With

ErrExit:

With Err
  If .Number <> 0 Then
    MsgBox "Fehler in Prozedur:" & vbTab & "'hochzählen'" & vbLf & String(60, "_") & _
      vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
      "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
      .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
      "VBA - Fehler in Prozedur - hochzählen"
    .Clear
  End If
End With

On Error GoTo 0

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlAutomatic
  .DisplayAlerts = True
  .StatusBar = False
End With


End Sub


sonst musst du etwas genauer beschreiben, was genau geschehen soll, am besten in einer Beispieldatei.
Gruß Sepp


Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: erichm
Geschrieben am: 05.09.2015 18:02:41
Hallo Sepp,
jetzt läuft der Code wobei ich folgende Änderung vornehmen musste:
1. EXCEl auf "automatisch rechnen" eingestellt (normal rechne ich nur bei Bedarf mit F9)
2. bei Application ".Calculation = xlManual" entnommen
3. .Calculate entnommen
Allerbesten Dank - funktioniert bestens!!
Bei der Gelegenheit noch eine Frage:
Bei der Frage hast Du mir einen Code bereitgestellt:
https://www.herber.de/forum/archiv/1444to1448/t1445001.htm
Da werden aus 25 Kunden 5 zufällige Reihen á 5 Kundennummern ohne Doppelte erstellt. So ganz habe ich den Code doch nicht verstanden für diese Änderung:
33 Kunden
4 Reihen
á 7 Kunden ohne Doppelte
Das war der Code:

Sub zufallsblock()
Dim vntNumbers As Variant, vntOut(1 To 5, 1 To 6) As Variant, vntRnd(1 To 25) As Variant
Dim vntRet As Variant, vntAnswer As Variant
Dim lngI As Long, lngR As Long, lngC As Long, lngBlock As Long
vntAnswer = Application.InputBox("Wie viele Blöcke?", "Zufall", 1, Type:=1)
If vntAnswer <> CStr(False) And vntAnswer > 0 And vntAnswer <= 1000 Then
  vntNumbers = Sheets("Zufallskunden").Range("B2:Z2")
  Sheets("Tabelle1").Range("A2:Z" & Rows.Count) = ""
  Sheets("Tabelle1").Range("A2:Z" & Rows.Count).Interior.ColorIndex = xlNone
  For lngBlock = 1 To vntAnswer
    Randomize Timer
    
    For lngI = 1 To 25
      vntRnd(lngI) = Rnd
    Next
    
    lngR = 1
    lngC = 1
    
    For lngI = 1 To 25
      vntRet = Application.Match(Application.Min(vntRnd), vntRnd, 0)
      vntOut(lngR, lngC + 1) = vntNumbers(1, vntRet)
      vntOut(lngR, 1) = lngR + (lngBlock - 1) * 5
      vntRnd(vntRet) = 99
      lngC = lngC + 1
      If lngI Mod 5 = 0 Then
        lngR = lngR + 1
        lngC = 1
      End If
    Next
    With Sheets("Tabelle1").Range("A2").Offset((lngBlock - 1) * 5, 0).Resize(5, 6)
      .Value = vntOut
      .Interior.ColorIndex = IIf(lngBlock Mod 2 = 0, 24, 35)
    End With
  Next
End If
End Sub
Besten Dank nochmal!
mfg
Geht das auch noch, wenn aus 30 Zahlen

Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: Sepp
Geschrieben am: 05.09.2015 18:21:21
Hallo Erich,
hab den Code angepasst. Damit kannst du beliebig festlegen, aus wie vielen Reihen bzw. Spalten ein Block bestehen soll. Den Bereich mit den Kundennummern musst du ggf. natürlich anpassen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub zufallsblock()
Dim vntNumbers As Variant, vntOut() As Variant, vntRnd() As Variant
Dim vntRet As Variant, vntAnswer As Variant
Dim lngI As Long, lngR As Long, lngC As Long, lngBlock As Long

'Einstellungen
Const cMaxBlock As Long = 1000 'Maximale Anzahl an Blöcken
Const cBlockRows As Long = 4 'Zeilenanzahl eines Blockes
Const cBlockCols As Long = 7 'Spaltenanzahl eines Blockes (ohne Indexspalte!)

vntAnswer = Application.InputBox("Wie viele Blöcke? (1 bis " & cMaxBlock & ")", "Zufall", 1, Type:=1)

If vntAnswer <> CStr(False) Then
  If vntAnswer > 0 And vntAnswer <= cMaxBlock Then
    vntNumbers = Sheets("Zufallskunden").Range("B2:AH2") 'Bereich mit den Kundennummern!
    
    With Sheets("Tabelle1")
      With .Range(.Cells(2, 1), .Cells(.Rows.Count, cBlockCols + 1))
        .Value = ""
        .Interior.ColorIndex = xlNone
      End With
    End With
    
    Redim vntRnd(1 To UBound(vntNumbers, 2))
    Redim vntOut(1 To cBlockRows, 1 To cBlockCols + 1)
    
    Randomize Timer
    
    For lngBlock = 1 To vntAnswer
      
      For lngI = 1 To UBound(vntNumbers, 2)
        vntRnd(lngI) = Rnd
      Next
      
      lngR = 1
      lngC = 1
      
      For lngI = 1 To UBound(vntNumbers, 2)
        vntRet = Application.Match(Application.Min(vntRnd), vntRnd, 0)
        vntOut(lngR, lngC + 1) = vntNumbers(1, vntRet)
        vntOut(lngR, 1) = lngR + (lngBlock - 1) * cBlockRows
        vntRnd(vntRet) = 99
        lngC = lngC + 1
        If lngI Mod cBlockCols = 0 Then
          lngR = lngR + 1
          lngC = 1
        End If
        If lngR > cBlockRows Or lngC > cBlockCols Then Exit For
      Next
      
      With Sheets("Tabelle1")
        With .Range("A2").Offset((lngBlock - 1) * cBlockRows, 0).Resize(cBlockRows, cBlockCols + 1)
          .Value = vntOut
          .Interior.Color = IIf(lngBlock Mod 2 = 0, RGB(225, 225, 245), RGB(215, 215, 235))
        End With
        .Columns.AutoFit
      End With
    Next
  Else
    MsgBox "Ungültige Eingabe!"
  End If
End If
End Sub


Gruß Sepp


Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: erichm
Geschrieben am: 05.09.2015 19:15:36
DANKE, geht ja fix - und eine äüßerst komfortable Lösung!!
mfg

Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: Sepp
Geschrieben am: 05.09.2015 19:23:33
Hallo Erich,
wenn du das öfters und in verschiedenen Konstellationen brauchst, würde sich ein Formular zur Bedienung anbieten.

Gruß Sepp


Bild

Betrifft: AW: Code 100x laufen lassen und "Werte hochzählen"
von: erichm
Geschrieben am: 05.09.2015 21:34:43
DANKE für den Hinweis; das könnte passieren - der Code gibt zu weiteren Überlegungen Anlass :)
EXCEL ist halt ne feine Sache - man muss die Möglichkeiten nur wissen.
Aber in diesem Forum hier wird immer bestens geholfen!!
Danke.
mfg

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Code 100x laufen lassen und "Werte hochzählen""