Herbers Excel-Forum - das Archiv

Algorhitmus für Zahlenreihe

Bild

Betrifft: Algorhitmus für Zahlenreihe
von: Norb
Geschrieben am: 24.09.2003 17:07:58
Hallo Profis.

ich wende mich nochmal mit einem alten Problem an euch.

Und zwar will ich eine Datenreihe erzeugen von der der Startwert, der Endwert und das Intervall bekannt sind. Das ist auch kein Problem, nur soll in diese Reihe auch noch andere Zahlen eingefügt werden, und am besten noch an der richtigen Stelle. In Excel ist es für meine Begriffe nicht zu realisieren und in VBA bin ich kein Profi, aber ich denke, es ist zu machen, oder ???

Beispiel:
Startwert: 0
Endwert: 2000
Intervall: 100
Wert1: 467
Wert2: 980
Wert3: 1579

Ergebnis: 0,100,200,300,400,467,500,600,700,800,900,980,1000,1100,1200,1300,1400,1500,1579,1600,1700,1800,2000 (Ende)

...das ganze allerdings in einer Spalte und nicht inner Zeile.

Zusatzfrage: Mit welchem Befehl kann ich ne ganze Spalte ab hier löschen (nur inhalte)

Vielen Dank, mal im Vorab...

Gruß Norb

Bild

Betrifft: AW: Algorhitmus für Zahlenreihe
von: ChrisL
Geschrieben am: 24.09.2003 17:25:58
Hi Norb

Siehe Anhang...
https://www.herber.de/bbs/user/1152.xls

Option Explicit



Sub Intervall()
Dim i As Long
Dim iZeile As Long
Range("D:D").ClearContents
For i = Range("B1") To Range("B2") Step Range("B3")
Cells(Range("D65536").End(xlUp).Row + 1, 4) = i
For iZeile = 5 To Range("B65536").End(xlUp).Row
If Cells(iZeile, 2) > i And Cells(iZeile, 2) < i + Range("B3") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = Cells(iZeile, 2)
Next iZeile
Next i
End Sub


Gruss
Chris
Bild

Betrifft: AW: Algorhitmus für Zahlenreihe
von: Norb
Geschrieben am: 24.09.2003 17:32:20
Hallo Chris.

Zunächst mal vielen Dank für Deine Antwort.

Kannst Du mir bitte deine Beispiel-Datei auch als email zusenden, da ich hier zwecks Firewall keine Daten vom Server runterladen kann.

Das wär klasse !!!

Email: n.hils@sw-machines.com

Gruß Norb
Bild

Betrifft: AW: Algorhitmus für Zahlenreihe
von: ChrisL
Geschrieben am: 24.09.2003 17:34:01
OK Mail unterwegs.

Gruss
Chris
Bild

Betrifft: Formellösung ohne matrixfunktion
von: IngoG
Geschrieben am: 25.09.2003 01:12:01
Hallo Norb?,
trage deine werte folgendermassen in ein tabellenblatt ein.

a1:startwert
a2:zielwert
a3 intervall
a4:wert1
a5:wert2
a6:wert3
...
a30: wert27

formel:

b1: =a1
b2: =WENN(B1>=$A$2;"";MIN($A$1+GANZZAHL((B1-$A$1+$A$3)/$A$3)*$A$3;WENN(ISTFEHLER(KKLEINSTE($A$4:$A$30;ZÄHLENWENN($A$4:$A$30;"<="&B1)+1));$A$2;KKLEINSTE($A$4:$A$30;ZÄHLENWENN($A$4:$A$30;"<="&B1)+1))))
diese formel kopierst Du genügend weit nach unten.

es werden alle werte in a4-a30 in dein intervall eingefügt.
Du mußt nur sicherstellen, dass kein wert < anfangswert ist.

ansonsten sollte es so funktionieren

Gruß Ingo
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: Norb
Geschrieben am: 25.09.2003 08:27:02
Moin, moin.

Wie gestern schon erwähnt, hat Dein Programm sehr gut funktioniert. Ich müsste nun aber noch paar Dinge abändern:

1. Es sollen nicht nur diese Vergleichswerte sondern auch deren Vielfache eingefügt werden und zwar für den Bereich Zwischen Start- und Zielwert.

2. Es soll für jeden Vergleichswert auch der Wert Vergleichswert + 1 eingefügt werden.

Beispiel:
Startwert: 0
Endwert: 10000
Intervall: 200
Vergleichswerte: 1050,4500,7800

Dann sollen folgende Werte in die Riehe 0 + 200 bis 10000 eingefügt werden:

1050
1051
2100
2101
3150
3151
4200
4201
4500
4501....

Außerdem soll noch berücksichtigt werden, dass diese Vergleichswerte auf einem anderen Tabellenblatt sind.

Ich hoff, Du kannst mir nochmal helfen.

Danke...

Norb

P.S.: Auch vielen Dank für die Antwort von Ingo...
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: ChrisL
Geschrieben am: 25.09.2003 11:50:03
Hi Norb

Option Explicit



Sub Intervall()
Dim i As Long
Dim iZeile As Long, Multiply As Long
Range("D:D").ClearContents
For i = Range("B1") To Range("B2") Step Range("B3")
Cells(Range("D65536").End(xlUp).Row + 1, 4) = i
If i + 1 < Range("B2") Then Cells(Range("D65536").End(xlUp).Row + 1, 4) = i + 1
Next i
For iZeile = 5 To Range("B65536").End(xlUp).Row
For Multiply = 1 To 100000
If Cells(iZeile, 2) * Multiply > Range("B2") Then Exit For
If Cells(iZeile, 2) * Multiply > Range("B1") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = Cells(iZeile, 2) * Multiply
Next Multiply
Next iZeile
Columns("D:D").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Gruss
Chris
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: Norb
Geschrieben am: 25.09.2003 13:21:23
Hallole.

Ich habs jetzt mal genau so eingefügt wie ichs von Dir bekommen hab. Ich denke, es bedarf nur noch einer kleinen Änderung, dann isses perfekt. So wie ich es jetzt habe, werden die regelmäßigen Werte +1 eingefügt. Dies ist hier nicht nötig, allerdings bei den einzufügenden Werten. Also genau umgekehrt.

Beispiel: Einzufügender Wert: 756 in die gleichmäßige Reihe (0+500 bis 2000)

Ergebnis: 0, 500, 756, 757, 1000, 1500, 1512, 1513, 2000 !!!

Auch bei 2*756=1512 gilt +1 !!!

Müsste eigentlich machbar sein, wo ich so kurz davor bin...

Danke !!!

Gruß Norb
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: ChrisL
Geschrieben am: 25.09.2003 13:38:11
Hi Norb

Option Explicit



Sub Intervall()
Dim i As Long
Dim iZeile As Long, Multiply As Long
Range("D:D").ClearContents
For i = Range("B1") To Range("B2") Step Range("B3")
Cells(Range("D65536").End(xlUp).Row + 1, 4) = i
Next i
For iZeile = 5 To Range("B65536").End(xlUp).Row
For Multiply = 1 To 100000
If Cells(iZeile, 2) * Multiply > Range("B2") Then Exit For
If Cells(iZeile, 2) * Multiply > Range("B1") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = Cells(iZeile, 2) * Multiply
If (Cells(iZeile, 2) * Multiply) + 1 > Range("B1") And _
(Cells(iZeile, 2) * Multiply) + 1 < Range("B2") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = (Cells(iZeile, 2) * Multiply) + 1
Next Multiply
Next iZeile
Columns("D:D").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub


Gruss
Chris
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: Norb
Geschrieben am: 25.09.2003 13:48:29
...that's it !!!

SENSATIONELL, Chris.

Ich danke Dir vielmals...

Gruß Norb
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: Norb
Geschrieben am: 25.09.2003 15:12:42
...ich bins nochmal.

Wie kann ich Excel sagen, dass die Ergenisse erst ab der 8. Zeile aufgelistet werden sollen, dann würde es um einiges Übersichtlicher werden. Ansonsten gehts ganz gut :-)

Gruß Norb.
Bild

Betrifft: AW: Algorhitmus @ ChrisL
von: ChrisL
Geschrieben am: 26.09.2003 11:40:12
Hi Norb

Option Explicit



Sub Intervall()
Dim i As Long
Dim iZeile As Long, Multiply As Long
Application.ScreenUpdating = False
Range("D8:D65536").ClearContents
For i = Range("B1") To Range("B2") Step Range("B3")
If Range("D8") = "" Then
Range("D8") = i
Else
Cells(Range("D65536").End(xlUp).Row + 1, 4) = i
End If
Next i
For iZeile = 5 To Range("B65536").End(xlUp).Row
For Multiply = 1 To 100000
If Cells(iZeile, 2) * Multiply > Range("B2") Then Exit For
If Cells(iZeile, 2) * Multiply > Range("B1") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = Cells(iZeile, 2) * Multiply
If (Cells(iZeile, 2) * Multiply) + 1 > Range("B1") And _
(Cells(iZeile, 2) * Multiply) + 1 < Range("B2") Then _
Cells(Range("D65536").End(xlUp).Row + 1, 4) = (Cells(iZeile, 2) * Multiply) + 1
Next Multiply
Next iZeile
Range("D8:D" & Range("D65536").End(xlUp).Row).Sort Key1:=Range("D8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub


Gruss
Chris
 Bild
Bewerten Sie hier bitte das Excel-Portal
Excel-Beispiele zum Thema " Algorhitmus für Zahlenreihe"
Vorkommen von Zahlenreihen in Spalten Summenformel unter Zahlenreihe eintragen
Teilergebnisse in Zahlenreihe eintragen und löschen Den jeweils letzten Wert einer Zahlenreihe als Multiplikator
Mittelwert einer Zahlenreihe bis zur Zeile mit der Formel Lücken aus Zahlenreihe listen
Reihenfolge einer Zahlenreihe nach dem Zufallsprinzip variieren Addition der 10 höchsten Werte einer Zahlenreihe