Excelformel: Gegeben sind 10.000€ - aufteilen in Scheine (500,200,100, ..etc)?

Hallo,

ich möchte mir das "zur Bank gehen" erleichtern.

Ich habe Budget X (Beispiel: 10.000€), diese sollen nun verteilt werden auf die jeweilig verfügbaren Euro-Scheine.

Die Summe muss insgesamt 100% ergeben.

Also:

Gegeben 10.000€

5x 500€

6x 200€

5x 100€ etc. - Bis zum 5€ Schein.

== 10.000€

Hat der wer eine Excelformel parat?

Danke und liebe Grüße

Folgendes habe ich mir gebastelt:

Bild zum Beitrag

VBA Code sieht aus wie folgt:

Sub Schaltfläche_Klicken()

    Dim totalBudget As Double
    Dim billValue As Double
    Dim billCount As Integer
    Dim billWeight As Double
    Dim remainingBudget As Double

    'Prompt user for total budget
    totalBudget = InputBox("Enter total budget:")
    remainingBudget = totalBudget
    ActiveSheet.Range("B9").Value = totalBudget

    'Array of bill types and weighting
    billTypes = Array(500, 200, 100, 50, 20, 10, 5)
    billWeights = Array(0.1, 0.2, 0.3, 0.2, 0.1, 0.05, 0.05)

    'Distribute budget based on weighting
    For i = 0 To 6
        billValue = billTypes(i)
        billWeight = billWeights(i)
        billCount = billWeight * (totalBudget / billValue)
        remainingBudget = remainingBudget - (billCount * billValue)
        ActiveSheet.Range("A" & i + 1).Value = billCount
    Next i
End Sub

Leider finde ich meinen Denkfehler noch nicht, da nicht der gesamteingegebene Wert verarbeitet wird. Häufig bleibt ein unlogisch Rest (bspw: User: 1450€, berechneter Geldwert der Scheine jedoch 1185€, sprich man hätte nochmal 2x 100€ mindestens ausgeben lassen können.

4 Antworten

hannes1806

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

19.01.2023, 09:32

Hallo, ja hab ich:
in B3-B9 kommet die verfügbare Stückzahl, in D2 der aufzuteilende Betrag

Bild zum Beitrag

Formel in D3 und runter kopieren:
=B3-D3
Formel in D3 und runter kopieren:
=MIN(ABRUNDEN(($D$2-SUMMENPRODUKT(A4:A$11;D4:D$11))/A3;0);B3)
Formel in D3 und runter kopieren::
=D3*A3

Wenn der Betrag rausgegeben ist, kannst du C3:C9 als Werte in B3:B9 kopieren.

Sehr interessante Aufgabe, ich habe die Lösung jetzt so gebaut:

Bild zum Beitrag

In Spalte B kommen die Stück und in D eine beliebige Gewichtung.

Alle folgenden Formeln sind nach unten kopierbar.

In E3 wird die Ideale Stückzahl berechnet:
=ABRUNDEN($C$2/SUMMENPRODUKT($A$3:$A$9;$D$3:$D$9)*D3;0)

In F3 ein erster Wurf, wieviel entnommen werden sollte, um auf die ideale Stückzahl zu kommen: =MAX(B3-E3;0)

In G3 ein 1. Wurf, was dafür gewechselt werden soll: =MAX(E3-B3;0)

Wegen der Rundungen und Stückelungen ergibt sich dabei ein Fehler in H3:
=GANZZAHL(((H$2-SUMMENPRODUKT(H4:H16;A4:A16))/A3))

In I3 wird der Fehler korrigiert, also so viel entnimmst du tatsächlich:
=WENN(H3*F3=0;F3;F3-H3)

In J3 wird der Sack zugemacht :
=G3+H3-F3+I3

In K3 eine Kontrolle:
=B3-I3+J3

In F2 kommt dann noch diese Formel, welche du auf G2 und I2:K2 kopieren kannst
=SUMMENPRODUKT(F3:F9;$A$3:$A$9)

Und in H2 steht =F2-G2

So schaut's jetzt aus:

Bild zum Beitrag

C1: =SUMMENPRODUKT(C3:C9;B3:B9)
C3: =RUNDEN($B$1/SUMMENPRODUKT($B$3:$B$9;$A$3:$A$9)*A3;0)
D1: =B1-C1
D3:
=WENNFEHLER(GANZZAHL(($D$1-SUMMENPRODUKT(D$2:D2;B$2:B2))/B3);0)
E1: =SUMMENPRODUKT(E3:E9;$B3:$B9)
E3: =D3+C3

Woher ich das weiß:eigene Erfahrung – Faulheit >> Neugier >> Wissen

PixL86

Fragesteller

19.01.2023, 09:48

Hallo hannes1806,

erst einmal: vielen Dank für dein Hirnschmalz. Ist nicht ganz so trivial wie ursprünglich vermutet. Habe auch bereits eine KI damit beauftragt, die aber gar nicht versteht was ich erreichen möchte.

So auch bei Dir: "Verfügbare Stückzahl"? Wovon!?

Ich schätze, ich habe mich unglücklich ausgedrückt. Was ich erreichen möchte, ganz simpel ausgedrückt:

Ich habe 10.000€ Bar in der Hand, gehe zur Bank und möchte die 10.000€ quasi wechseln in kleinere Scheine für die Kasse. Sprich: gleichmäßig die 10.000€ auf alle Geldscheine verteilen. Ideal wäre sogar eine Gewichtung. (Ich stelle fest, ich habe noch n 500€ Scheine, benötige also hiervon relativ weniger, dafür evtl. mehr 200€ Scheine da keine mehr vorhanden.)

Liebe Grüße und vielen Dank!

hannes1806

19.01.2023, 15:03

@PixL86

Hallo, ich habe meine Antwort ergänzt, siehe ab "Sehr interessante Aufgabe,..."

PixL86

Fragesteller

19.01.2023, 10:09

Ich habe meinen Eingangspost etwas editiert. Evtl. wird es hiermit etwas klarer :)

Nochmals: vielen Dank für Deinen Einsatz! :)

hannes1806

20.01.2023, 12:17

@PixL86

ich habe meine Antwort auch nochmal ergänzt, kein VBA. nur Formeln.

GutenTag2003

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, Excel-Formel, Office- & Büroanwendungen

19.01.2023, 11:26

Wenn es keine Vorgaben gibt, welche und wie viele davon präferiert werden, würde ich mir so helfen und vortasten (Auswahl/Anzahl entsprechend B14:B20) auswählen.

In B11 =+B1*A1+B2*A2+B3*A3+B4*A4+B5*A5+B6*A6+B7*A7

Bild zum Beitrag

PixL86

Fragesteller

19.01.2023, 11:57

Hallo GutenTag2003,

auch eine gute Idee, vielen Dank. Ich schaue mal, dass ich das in mein Makro geschubst bekomme.

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

19.01.2023, 19:35

Hier ne Lösung in Java, die man auch in VBA nachbauen kann.
Geldstückelung ♨󠄂‍󠆷 Java - Hilfe | Java-Forum.org

AnnukaSi

19.01.2023, 07:01

Du müsstest erst einmal eine Hilfstabelle erstellen wo deine verfügbaren Anzahl an Geldscheinen gezeigt wird. Daraus errechnet du dann mit dem ABRUNDEN-Befehl wieviel Höhe Geldscheine du haben willst. Mit dem Wert was übrig bleibt erhält du die Summ der anderen

PixL86

Fragesteller

19.01.2023, 07:07

Danke für deinen Ansatz. :)

Die Hilfstabelle ist klar. Aber wie würde die Formel dazu dann aussehen? Hättest Du hier vielleicht einen Ansatz?

AnnukaSi

19.01.2023, 07:14

@PixL86

Das müsste man im Programm machen. Wenn ich vor so Excel-Problemen stehe zeichne ich mit die Logig erstmal auf Papier. Dann kommt die Lösung wie ich was berechnen muss fast von alleine.

Hallo nochmals,

ich habe mit hilfe con einigen "gutefrage.net" usern einen code geschrieben und versuche jzt durch "Copy-Paste" es für jede Zelle anzuwenden.

Beim For-Befehl kommt immer folgende Meldung "For Steuervariabel wird bereits verwendet"

was bedeutet das ? heißt es, das man das "For" nur einmal in einem code gebrauchen kann ? wäre vielleicht ein "GoTo" befehl angebrachter? ( sprich: go to next cell, wenn die bedingung erfüllt ist )

hier ist der code:

sub kopieren( )

Dim Zelle As Range Dim Wert As Variant

Wert = ActiveSheet.Range("J16:j29")

With Sheets("Tabelle2") For Each Zelle In .Range("F6:G6")

If ((Range("J16").EntireRow.Hidden = True)

Or (Range("J16").EntireColumn.Hidden = True))

Or (Range("J16").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J17")

Else

Zelle.Value = ActiveSheet.Range("J16")

With Sheets("tabelle2")

For Each Zelle In .Range("H6:I6")

If ((Range("J17").EntireRow.Hidden = True)

Or (Range("J17").EntireColumn.Hidden = True))

Or (Range("J17").Font.Strikethrough = True) Then

Zelle.Value = ActiveSheet.Range("J18")

Else

Zelle.Value = ActiveSheet.Range("J17")

End If End With End If Next Zelle End With End Sub

Danke schonmal für eure Tatkräftigen Hilfen :)))

Gruß Newb

...zur Frage

In Excel Makros aus aktiven Sheet löschen?

Ich Möchte ein Tabellenblatt neben das Original kopieren, in dem man nichts mehr ändern kann, aber anschliesssend die Sub Makros aus der Kopie Löschen, da sonnst die Datie zu groß wird. Das Kopieren funktioniert super, nur mit den Makros entfernen noch nicht so.

Das ist mein Code zum Kopieren, Danke

Sub NeuesTabBlatt()
' Monate Soll
 If MsgBox("Wollen Sie wirklich einen neuen Sollplan erstellen?", vbYesNo) = vbYes Then
 If InputBox("geben sie Bitte das Passwort zum Entsperren ein", "  Sollplanerstellung") = "1234" Then
        MsgBox "OK, der Sollplan wird erstellt"
 Else
 MsgBox "Hier kommst Du net rein!"
 ActiveSheet.Range("$A$1").Select
 Exit Sub
 End If
Application.ScreenUpdating = False
Application.Calculation = False
Dim NewName As String
ActiveWorkbook.Unprotect Password:="1234"
NewName = ActiveSheet.Range("$CW$1")
ActiveSheet.Copy After:=ActiveSheet
 ActiveSheet.Name = "Soll" & " " & ActiveSheet.Range("CW1")
  ActiveSheet.Range("AT127:AV134,AQ133:AS133, AT183:AV186, AT228:AV232").Clear
       ZeilenEinUndAusblenden
    ActiveSheet.EnableSelection = xlNoSelection
   ActiveSheet.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True
   ActiveSheet.Visible = False
  ActiveWorkbook.Protect "1234", Structure:=True
  Application.Calculation = xlAutomatic
 Application.ScreenUpdating = True
 MsgBox "ein neues SOLL Tabellenblatt wurde erstellt"
 End If
 'BlätterSollEinAus
 ActiveSheet.Range("$A$1").Select
End Sub

...zur Frage

Wie kann ich in VB einen Double mit Punkt auslesen?

Hey, ich habe ein Problem, ich will (in VB) mit einem double Komma Zahlen rechnen (das Funktioniert auch so) aber wenn ich sie zu einem String konvertiere (.toString) dann bekomme ich nur soetwas raus: "123456", also ohne Punkt :/ Kann mir jemand helfen? Danke im Voraus :)

Code: Dim Verbrauch As Double = Double.Parse(Wert2a.Text & "." & Wert2b.Text) - Double.Parse(Wert1a.Text & "." & Wert1b.Text)

...zur Frage

Wie kann ich bei Excel einen Button erstellen der abspeichert?

Hallo,

Ich würde gerne bei Excel einen Button erstellen, der die Excel mappe auf dem Desktop abspeichert. Der Name der Datei soll in Zeile A1 stehen.

Den Button habe ich bereits erstellt. Ich scheitere noch bei dem Makro, weil ich keine ahnung davon habe. Ich habe etwas im Internet gefunden, was meinen Vorstellungen nahe kommt. Ich habe versucht es anzupassen, aber irgendwie klappt das alles nicht.

Sub Schaltfläche1_Klicken()
Dim lw_pfad As String
lw_pfad = ActiveSheet.Range("A1").Value
lw_pfad = InputBox("Geben Sie hier das Laufwerk und den Pfad an, wo die Datei gespeichert werden soll." & Chr(13) & Chr(13) & "(Ihre Eingabe wird in A1 als neuer Default-Wert gespeichert.)", "Datei speichern unter...", lw_pfad)
If lw_pfad = "" Then
  MsgBox "Die Datei wird nicht gespeichert, da Sie [Abbrechen] gedrückt oder nichts eingegeben haben.", , "Abbruch"
  Exit Sub
Else
  If Right(lw_pfad, 1) <> "\" Then lw_pfad = lw_pfad & "\"
  ActiveSheet.Range("A1").Value = lw_pfad
Rem MsgBox lw_pfad
ActiveWorkbook.SaveAs lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls"
MsgBox "Die Datei wurde unter " & lw_pfad & ActiveSheet.Range("B2").Value & ActiveSheet.Range("C4").Value & ".xls gespeichert.", , "OK"
End If
End Sub

Das ist, was ich bis jetzt habe.

Vielen Dank für die Hilfe im Voraus!

...zur Frage

Excel VBA eine definierte Shape bewegen?

Hallo Zusammen,

Ich habe in einem File mit zwei Blättern (Genehmigung und Planung) einen Balken (benannt "Datumsbalken"). Dieser ist jeweils auf dem heutigen Tag fixiert.

Jetzt will ich seine Verschiebung anhand des heutigen Datums automatisieren. Ich bringe jedoch das Makro nicht zum laufen. Was ist mein Fehler?

Sub BalkenSchieben3()
 
    Dim Today As Variant
    Dim Last As Variant
    Dim TodaySheet As Variant
    Dim Difference As Variant
    Dim Form As Shape
 
    Set Form = Sheets("Planung").Shapes.Range("Datumsbalken") '(Array("Datumsbalken")) soll die Shape "Datumsbalken" suchen
    Set Today = Date 'Setzt das heutige Datum
    Set Difference = Sheets("Genehmigung").Range("AO3") 'Setzt den Unterschied zwischen letzter Bearbeitung und Heute
    Set TodaySheet = Sheets("Genehmigung").Range("AK3")
    
        If Difference > 0 Then
            For Difference = 1 To Difference 'Die Anzahl Tagesunterschiede (Difference) entscheidet, wie viele Male der Balken verschoben werden soll.
                With Sheets("Planung")
                    Form.Select
                    Selection.ShapeRange.IncrementLeft 21
                End With
                
            Next
            
            Else
        End If
    
    Set Sheets("Genehmigung").Range("AK3") = Today 'Das heutige Datum wird in die Zelle abgespeichert
    Set Sheets("Genehmigung").Range("AM3") = TodaySheet 'Das letzte Bearbeitungsdatum (vorheriges "Heute") wird abgespeichert, damit die nächste Difference berechnet werden kann
 
End Sub

Vielen Dank im Voraus!

...zur Frage

Alle Inhalte eines Array unbekannter Länge hintereinander ausgeben?

Ich muss für den Informatik Unterricht in einem Programm alle inhalte des Array hintereinanden in einer Zeile ausgeben. Das Problem dabei ist, dass ich die Größe des Array nicht festlegen will.

Das heißt dann:

Dim Array(x) As long

txt_Ausgabe.Text = ....?

txt_Ausgabe ist eine Multiline Textbox

...zur Frage

VBA Datum (dd.mm.yy) aus Zelle umdrehen (yymmdd) und als Name speichern?

Hallo Zusammen

Ich bin ganz neu im VBA und bin etwas am Herumprobieren. Einen Teil habe ich geschafft, aber an einem Punkt hänge ich.

Ich will, dass ein Makro läuft, welches die Datei automatisch unter dem Namen "Kundennummer_Servicedatum" abspeichert. Die Kundennummer und das Servicedatum sind beide im Dokument unter separaten Zellen hinterlegt, die Formel sieht jetzt so aus:

Sub Speichern_unter()

Dim SaveName As String

Dim Datum As Date

SaveName = ActiveSheet.Range("BQ11").Text

Datum = ActiveSheet.Range("BM17")

ActiveWorkbook.SaveAs Filename:="D:\ABC\Service\" & SaveName & "_" & Datum & ".xls"

End Sub

Soweit funktioniert alles, das Dokument heisst z.b. "149_31.10.23"

Das Datum ist als dd.mm.yy in der Zelle, zum Abspeichern brauche ich aber folgendes Format: yymmdd. Ziel ist also der Name "149_231031"

Kann mit jemand helfen, wie ich das Datum umgedreht bekomme? Danke im Voraus :)

...zur Frage

Zweidimensionales Array einlesen?

Hallo Ich möchte eine Tabelle mit 2 Spalten per Array in Excel VBA per Array einlesen lassen. Mein Programmcode sieht bisher so aus:

Sub aaaaa()

Dim bbbb(1 To 8, 1 To 2)

Dim i As Integer

For i = 1 To 8

bbbb(i, 1) = Worksheets("cccc").Range("i1").Value

bbbb(i, 2) = Worksheets("cccc").Range("i2").Value

Next i

End Sub

Leider funktioniert das Ganze nicht. Hat jemand eine Idee woran es liegen könnte?

Danke!

...zur Frage

Excel: Wie gestalte ich dieses Makro schneller und effektiver und sorge dafür, dass es bei Neustart nur neue Werte erkennt?

Wie kann ich dieses Makro schneller und effektiver machen und wie bekomme ich es hin, dass es beim Neustart nicht schon wieder die Werte erkennt, die schon einmal dran waren? Sodass die 50 nach dem ersten Mal Abspielen des Sounds ignoriert wird.

Code:

Sub PlaySound()
  Dim ws As Worksheet
  Dim rng As Range
  Dim cell As Range
  Dim goals As Long
  Dim soundFile As String
  Dim thresholds As Variant
  Dim i As Integer
  Set ws = ThisWorkbook.Worksheets("Spielplan")
  Set rng = ws.Range("O1:O" & ws.Cells(ws.Rows.Count, "O").End(xlUp).row)
  soundFile = "Sound_pfad.mp3"
  'Array of threshold values
  thresholds = Array(50, 100, 150, 200, 250, 300, 350, 400, 450, 500,550,600,650,700,750,800,850,900,950,1000)
  Do While True 'Endlosschleife hinzugefügt
    For Each cell In rng
      If IsNumeric(cell.Value) Then
        goals = goals + cell.Value
        'Check if goals is equal to any of the threshold values
        For i = LBound(thresholds) To UBound(thresholds)
          If goals = thresholds(i) Then
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            ActiveSheet.OLEObjects.Add(Filename:=soundFile, Link:=False, DisplayAsIcon:=False).Select
            Selection.Verb Verb:=xlPrimary
            Selection.Delete
            Application.ScreenUpdating = True
            Application.EnableEvents = True
          End If
        Next i
      End If
    Next cell
    'Verzögerung hinzugefügt, um die CPU-Auslastung zu reduzieren
    Application.Wait (Now + TimeValue("0:05:00"))
  Loop
End Sub

...zur Frage

Excel Makro Kontrollkästchen mit Zellbezug?

Hi, ich würde gerne immer die Zellverknüpfung eines Kontrollkästchens auf die überliegende Zelle beziehen. Jetzt habe ich ein Makro gefunden, welches scheinbar immer die rechte Nachbarzeile zuweist, ich hätte aber gerne die darüberliegende, wie muss ich dieses Skript anpassen?

Option Explicit 
Sub
 zellverknuepfung()
Dim Cb As CheckBox
For Each Cb In Tabelle1.CheckBoxes
Cb.LinkedCell = Cb.TopLeftCell.Offset(0, 1).Address
Next Cb
End Sub

Habe ca. 100 Kästchen und finde das per Hand sehr mühsam.
Bin froh um jeden Tipp :)

...zur Frage

VBA Programmierung - Automatischer Email versandt Probleme?

Hallo ich hoffe Ihr könnt mir helfen :/

Folgendes Problem: Wenn ich die Mail versende, öffnen sich für jede Zeile eine extra Email und leider auch nur jeweils ein Empfänger und einer in cc.

Was muss ich nun in der Programmierung hinzufügen, um nur eine Email geöffnet zu bekommen, mit mehreren Empfängern (Falls mehrere Kreuze gesetzt worden sind). Ich danke euch echt wenn Ihr mir helfen können :/

Ich habe mir die Bausteine aus dem Internet zusammengesetzt, bin daher kein Profi darin.

Programmtext:

Private Sub Send_Email()
   '-------------< Send_Email() >-------------
   Dim sTitle As String
   sTitle = "Test-HTML Email from Excel"
   '< HMTL holen >
   Dim sTemplate As String
   sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text
   '</ HMTL holen >
   '----< Send with Outlook >----
   Dim app_Outlook As Outlook.Application
   Set app_Outlook = New Outlook.Application
   '--< Email einstellen >--
   Dim objEmail As Outlook.MailItem
   Dim sEmail_Addresscc As String
   Dim sEmail_Address As String
   Dim iRow As Integer
   For iRow = 4 To 100
       If Cells(iRow, 21) = "x" Then
           '< get Email Address >
           'Column 2, B
           sEmail_Address = Cells(iRow, 19)
           sEmail_Addresscc = Cells(iRow, 20)
           '</ get Email Address >
           '< Fill Placeholders >
           Dim sHTML As String
           sHTML = Replace(sTemplate, "[@Name]", sEmail_Address)
           '</ Fill Placeholders >
           '--< Send Email >--
           Set objEmail = app_Outlook.CreateItem(olMailItem)
           objEmail.To = sEmail_Address
           objEmail.CC = sEmail_Addresscc
           objEmail.Subject = sTitle
           'objEmail.HTMLBody = sHTML 'use .HTMLBody for HTML
           objEmail.Body = sHTML      'and .body for pure Text
           objEmail.Display
           '--</ Send Email >--
       End If
   Next
   '< Abschluss >
   Set objEmail = Nothing
   Set app_Outlook = Nothing
   '</ Abschluss >
   MsgBox "Emails erstellt", vbInformation, "Fertig"
   '----</ Send with Outlook >----
   '-------------</ Send_Email() >-------------
End Sub

...zur Frage

VBA: Split-Funktion mit einem Trennzeichen?

Hallo zusammen,

ich stehe vor einem Problem, woran ich schon seit Tagen arbeite und keine Lösung finde.

Meine Split-Funktion klappt soweit, die Daten werden eingefügt. Allerdings in der ersten der ersten Zeile von (D). Ich benötige die Daten aber ab Zeile (D20) und das bekomme ich nicht hin.

Hat bitte jemand einen Lösungsvorschlag, da ich nicht so fit mit VBA bin?

Dim MeinArray() As String
Dim MeineZeichenkette As String
Dim I As Variant
Dim N As Integer
Dim WB As Worksheet
Set WB = ThisWorkbook.Sheets("Abrechnung")

Dim WBlerf As Worksheet
Set WBlerf = ThisWorkbook.Sheets("Tabelle1")
Ziel = WBlerf.Range("D20")

'Beispielzeichenkette mit Semikolon als Trennzeichen
MeineZeichenkette = WB.Range("Aufmaß_srvpos")

'Die Funktion Split verwenden, um die Bestandteile der Zeichenkette aufzuteilen
MeinArray = Split(MeineZeichenkette, ";")

'Das Arbeitsblatt leeren
'ActiveSheet.UsedRange.Clear

'Durch das Array iterieren
For N = LBound(MeinArray) + 0 To UBound(MeinArray)
  'Jede E-Mail-Adresse in die erste Spalte des Arbeitsblatts einfügen
  WBlerf.Range("D" & N + 1).Value = MeinArray(N)
Next N

Lieben Dank und VG

Stefan

...zur Frage

VBA Counter Problem?

Hallo Zusammen,

ich hab ein Problem in VBA. Ich muss bei jedem klicken auf Raten den counter +1 erhöht werden. Leider ergibt sich bei mir eine Endlos-Schleife. Brauche Hilfe.

Private Sub btnRaten_Click()
Dim Userzahl As Integer 'Eingegebene Zahl
Dim PCzahl As Integer 'Zufallszahl
Dim anzahl As Integer
Dim Ende As Boolean


anzahl = 0


PCzahl = Int((Rnd() * 100) + 1)


Userzahl = Val(tbxEingabe.Value)


Ende = False


Do Until Ende = True


anzahl = anzahl + 1


If Userzahl < PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu klein"
Ende = False


ElseIf Userzahl > PCzahl Then
lblAusgabe = "Die Zahl " & Userzahl & " ist zu groß"
Ende = False


ElseIf Userzahl = PCzahl Then
lblAusgabe = "Gewonnen!"
Ende = True


End If


lblCounter.Caption = anzahl
Loop


End Sub

Danke für eure Hilfe.

...zur Frage

Wie berechne ich 30 min Mittelwerte in VBA?

Hallo Zusammen ,

ich bin leider wirklich nicht fit was das Thema Makro schreiben angeht deshalb habe ich folgendes Problem:

Ich habe mehrer Spalten mit etwa 1000 Zeilen voller Daten. Es handelt sich dabei um Minutenwerte. Diese würde ich gerne in 30 min Werte zusammenfassen. Da das händisch ewig dauert bräuchte ich dafür ein Makro welches den Mittelwert bildet und 3 Spalten weiter in der ersten Zeile (wo auch der erste Werte der zur Mittelwertsberechnung rangezogen wird notiert ist). Dann soll der nächste Mittelwert mit den Folgenden 29 Minuten-Werten gebildet werden, 3 Spalten weiter unter dem vorherigen Mittelwert notiert werden.

Folgendes habe ich versucht:

Sub Halbstundenmittelwerte()

Dim i As Integer

Dim z As Integer

Dim x As Integer

Dim MW As Double

For i = 10 To 15010 Step 30

z = i

x = z + 29

Range(Hz).Select

ActiveCell.FormulaR1C1 ="= AVERAGE("Cz:Cx")"

Range(Hi).Value = MW

Next i

End Sub

Danke euch !

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen