Runterzählen innerhalb einer Spalte

teest · 1970-01-01T00:00:00+00:00

Hey! Habe wiedermal ein Problem und nirgends etwas dazu gefunden: Wie muss ich ein Makro aufbauen, welches den Wert aus einer bestimmten Zelle nimmt und danach in einer anderen Spalte runterzählt, Zeile für Zeile bis es bei 1 ist und wieder von vorne beginnt. Das ganze sollte erst stoppen wenn in einer Spalte "B" nichts mehr vorhanden ist. Meine Idee war es nun einen Loop zu erstellen welcher immer die "Obere Zelle" nimmt un davon -1 abzieht bis er bei 1 ist. Wie müsste ich das in Code umsetzen?

Hallo,
vielleicht geht es so.
kommt als Code in Tabelle

Option Explicit 
 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim ArrayDaten(), n&, nZaehler& 
Dim rngVorgabe As Range 
 
Set rngVorgabe = Range("A1") 'wo die Zahl steht 
 
If Intersect(rngVorgabe, Target) Is Nothing Then Exit Sub 
 
 
ArrayDaten = Range("B4", Cells(Rows.Count, 2).End(xlUp)) 
 
nZaehler = rngVorgabe.Value + 1 
 
For n = 1 To Ubound(ArrayDaten) 
   nZaehler = nZaehler - 1 
   ArrayDaten(n, 1) = nZaehler 
   If nZaehler < 2 Then nZaehler = rngVorgabe.Value + 1 
Next n 
 
Application.EnableEvents = False 
    Range("A4", Cells(Rows.Count, 1)).ClearContents 
    Range("A4").Resize(Ubound(ArrayDaten)) = ArrayDaten 
Application.EnableEvents = True 
End Sub

Die Tabelle ist bei mir so aufgebaut.

	A	B
1	5
2
3
4	5	Daten1
5	4	Daten2
6	3	Daten3
7	2	Daten4
8	1	Daten5
9	5	Daten6
10	4	Daten7
11	3	Daten8
12	2	Daten9
13	1	Daten10
14	5	Daten11
15	4	Daten12
16	3	Daten13
17	2	Daten14
18	1	Daten15
19	5	Daten16
20	4	Daten17
21	3	Daten18
22	2	Daten19
23	1	Daten20
24	5	Daten21
25	4	Daten22
26	3	Daten23
27	2	Daten24
28	1	Daten25
29	5	Daten26
30	4	Daten27
31	3	Daten28
32	2	Daten29

Gruß Tino

Hallo,
dann versuche es mit diesem Code.
kommt als Code in die Tabelle "Auswertung"

Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim ArrayDaten(), n&, nZaehler&, nLetzte& 
Dim rngVorgabe As Range 
Set rngVorgabe = Range("N53") 'wo die Zahl steht 
 
If Intersect(rngVorgabe, Target) Is Nothing Then Exit Sub 'andere Zelle 
If Not IsNumeric(rngVorgabe.Value) Then Exit Sub 'keine Zahl 
 
 With Sheets("data") 
      nLetzte = .Cells(.Rows.Count, 22).End(xlUp).Row 
      If nLetzte > 1 Then 'keine Daten, nLetzte = 1 
          ArrayDaten = .Range("V2", .Cells(nLetzte, 22)).Resize(, 2).Value2 
          Redim Preserve ArrayDaten(1 To Ubound(ArrayDaten), 1 To 1) 
          nZaehler = rngVorgabe.Value + 1 
          For n = 1 To Ubound(ArrayDaten) 
             nZaehler = nZaehler - 1 
             ArrayDaten(n, 1) = nZaehler 
             If nZaehler < 2 Then nZaehler = rngVorgabe.Value + 1 
          Next n 
       
      End If 
      Application.EnableEvents = False 
          .Range("K2", .Cells(.Rows.Count, 11)).ClearContents 
          If nLetzte > 1 Then 
            .Range("K2").Resize(Ubound(ArrayDaten)) = ArrayDaten 
          End If 
      Application.EnableEvents = True 
 End With 
End Sub

Gruß Tino

Zelle	Formel
C2	=A2
C3	=WENN(C2=1;A$2;C2-1)
C4	=WENN(C3=1;A$2;C3-1)

Runterzählen innerhalb einer Spalte

Forumthread: Runterzählen innerhalb einer Spalte

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial