Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.06.2025 22:11:12
Hilfe bei Urlaubsplan
24.06.2025 21:29:43
Gesamtlänge meiner Videos
24.06.2025 19:48:50
Blattansichten
24.06.2025 16:58:47
Werte/Zeilen einrücken (ein-ausblenden)
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
312to316
312to316
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Algorhitmus für Zahlenreihe

Forumthread: Algorhitmus für Zahlenreihe

Algorhitmus für Zahlenreihe
24.09.2003 17:07:58
Norb
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
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Kategorie
Algorithmus
Tags
#algorithmen #datenmanipulation #vba
Relevante Fragen
Anzeige
Betreff
Datum
Anwender
Anzeige
AW: Algorhitmus für Zahlenreihe
24.09.2003 17:25:58
ChrisL
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
Anzeige
AW: Algorhitmus für Zahlenreihe
24.09.2003 17:32:20
Norb
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
Anzeige
AW: Algorhitmus für Zahlenreihe
24.09.2003 17:34:01
ChrisL
OK Mail unterwegs.

Gruss
Chris
Formellösung ohne matrixfunktion
25.09.2003 01:12:01
IngoG
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
Anzeige
AW: Algorhitmus @ ChrisL
25.09.2003 08:27:02
Norb
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...
Anzeige
AW: Algorhitmus @ ChrisL
25.09.2003 11:50:03
ChrisL
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
Anzeige
AW: Algorhitmus @ ChrisL
25.09.2003 13:21:23
Norb
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
Anzeige
AW: Algorhitmus @ ChrisL
25.09.2003 13:38:11
ChrisL
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
Anzeige
AW: Algorhitmus @ ChrisL
25.09.2003 13:48:29
Norb
...that's it !!!

SENSATIONELL, Chris.

Ich danke Dir vielmals...

Gruß Norb
AW: Algorhitmus @ ChrisL
25.09.2003 15:12:42
Norb
...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.
Anzeige
AW: Algorhitmus @ ChrisL
26.09.2003 11:40:12
ChrisL
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige