Automatischer Eintrag eines Wertes in einer Zelle?

...komplette Frage anzeigen

3 Antworten

Bleibt die Anzahl der Zeilen in A/B übersichtlich, also sagen wir mal weniger als 10?
Dann klappt das recht einfach mit einer WENN-Verschachtelung (hier für die von Dir vorgegeben DREI Zeilen, ist aber leicht erweiterbar, notfalls auch auf mehr als 10):

=WENN(ZEILE(A1)<=$B$1;$A$1;WENN(ZEILE(A1)<=SUMME($B$1:$B$2);$A$2;WENN(ZEILE(A1)<=SUMME($B$1:$B$3);$A$3;"")))

und runterkopieren soweit wie nötig.

Wenn es deutlich mehr sind, müsste ich nochmal überlegen oder doch auf VBA zurückgreifen.

Aritmatos 18.05.2017, 14:49

Danke, es sind nicht mehr als 10, meistens so zwei bis vier. die Formel Klapp ziemlich gut.

0
Oubyi 18.05.2017, 14:53
@Aritmatos

Dann sollte das reichen, da brauche ich nicht weiter nachzudenken.
Da ich die Formel noch offen habe, habe ich sie mal auf max. SIEBEN Einträge erweitert:

=WENN(ZEILE(A1)<=$B$1;$A$1;WENN(ZEILE(A1)<=SUMME($B$1:$B$2);$A$2;WENN(ZEILE(A1)<=SUMME($B$1:$B$3);$A$3;WENN(ZEILE(A1)<=SUMME($B$1:$B$4);$A$4;WENN(ZEILE(A1)<=SUMME($B$1:$B$5);$A$5;WENN(ZEILE(A1)<=SUMME($B$1:$B$6);$A$6;WENN(ZEILE(A1)<=SUMME($B$1:$B$7);$A$7;"")))))))

So wird auch die Struktur nochmal deutlicher.
Ich glaube EXCEL lässt inzwischen 255 Verschachtelungen zu.

1
Oubyi 18.05.2017, 15:39
@Oubyi

Falls Du doch lieber auf VBA zurückgreifst:
Ich würde das etwas anders aufziehen als Suboptimierer.
Dieser Code sollte die Aufgabe erledigen, egal wieviel Einträge in A/B stehen.
Teste aber mal genau (mit Sicherungskopie).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngZelle As Range
Dim i As Integer
Dim intStart As Integer
Dim intEnde As Integer

If Not Target.Column = 2 Then Exit Sub
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
intEnde = Cells(Rows.Count, 1).End(xlUp).Row
intStart = 1
Range("C:C").ClearContents
For Each rngZelle In Range(Cells(1, 2), Cells(intEnde, 2))
For i = intStart To intStart + rngZelle.Value - 1
Cells(i, 3).Value = rngZelle.Offset(0, -1).Value
Next i
intStart = intStart + rngZelle.Value
Next rngZelle
ErrorHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
1

Hallo zusammen

Ich habe eine Lösung gefunden, die sehr flexibel ist und ohne VBA auskommt. Die Werte Bahn, Schiff etc. werden in die Tabelle ab Zelle D1 eingetragen und ebenso deren gewünschte Häufigkeit in E1 und darunter.

In F1 wird manuell der Wert 0,1 eingegeben. In F2 kommt = F1+E1. Runterkopieren, soweit man möchte, aber mindestens eine Zeile weiter als mögliche Elemente vorkommen. Bahn, Bus, Fahrrad = 3, also bis Zeile 4.

Die Liste soll ab Zelle C1 (bis Cn) erstellt werden. In C1 kommt:

=WENN(ZEILE()<=SUMME($E:$E);BEREICH.VERSCHIEBEN($D$1;VERGLEICH(ZEILE();$F:$F;1)-1;0);"")

Runterkopieren, soweit die Liste maximal werden kann. Bisschen mehr schadet nichts. Fertig.

Jetzt kann man die Häufigkeiten verändern und die Liste passt sich automatisch an. Oder man schreibt Lastenfahrrad statt LKW. Oder ergänzt eine weitere Transportmöglichkeit.

Schick, oder?

Freue mich auf Feedback und Vorschläge, wie man die Aufgabemit Bereich.Verschieben() vielleicht noch eleganter lösen kann.

Gruß

Hannes

 - (Excel, Tabelle)

Ich würde es mit VBA machen, aber du könntest auch mit 3x ZÄHLENWENN arbeiten.

Aritmatos 18.05.2017, 14:18

Mit Zählenwenn wird das unheimlich sperrig, mit VBA kenne ich mich nicht gutgenug aus.

0
Suboptimierer 18.05.2017, 14:47
@Aritmatos

So in etwa würde der VBA-Code aussehen:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rMerk As Range
  If Not Intersect(Target, Range("B1:B3")) Is Nothing Then
    Range("C1").EntireColumn.Clear
    Set rMerk = Range("C1")
    If Range("B1").Value > 0 Then
      Set rMerk = Range("C1:C" & Range("B1").Value)
      rMerk.Value = Range("A1")
    End If
    If Range("B2").Value > 0 Then
      Set rMerk = rMerk.End(xlDown).Offset(1)
      Set rMerk = rMerk.Resize(Range("B2").Value)
      rMerk.Value = Range("A2")
    End If
    If Range("B3").Value > 0 Then
      Set rMerk = rMerk.End(xlDown).Offset(1)
      Set rMerk = rMerk.Resize(Range("B3").Value)
      rMerk.Value = Range("A3")
    End If
  End If
End Sub
1
Aritmatos 18.05.2017, 14:51
@Suboptimierer

Vielen Danke für deine Mühen, das VBA klappt sehr gut.

Ich schaue jetzt einfach, was praktischer ist für die Anwendung.

Mfg

Aritmatos

1
Suboptimierer 18.05.2017, 14:53
@Aritmatos

Mir sind ein paar Grenzwertfehler aufgefallen. Teste das Bitte noch ausführlich.

du könntest auch einen Laufindex für die aktuelle Zeile verwenden. Das ist wahrscheinlich fehlerunanfälliger.

i=1, dann i = i + B1, dann i = i + B2 sinngemäß

0
Aritmatos 18.05.2017, 14:57
@Suboptimierer

Ok, Ich habe es jetzt nur mit meiner Test Tabelle probiert, hier war kein Fehler. Aber ich werde es nochmal mit der Orginaltabelle testen.  

0

Was möchtest Du wissen?