Thema Datum  Von Nutzer Rating
Antwort
14.10.2020 20:00:05 Labyrinth
NotSolved
14.10.2020 21:35:57 Gast10030
NotSolved
15.10.2020 20:49:56 Labyrinth
NotSolved
15.10.2020 00:36:29 Gast72411
NotSolved
15.10.2020 00:52:26 Gast28728
NotSolved
15.10.2020 01:13:06 Gast68173
NotSolved
15.10.2020 20:59:30 Labyrinth
NotSolved
Blau ... mit Beispiel dazu
 15.10.2020 21:22:28 Gast72393
NotSolved
15.10.2020 21:25:34 Gast7567
NotSolved
15.10.2020 22:11:31 Gast7661
Solved
15.10.2020 22:16:55 Gast22247
NotSolved
15.10.2020 22:20:58 Gast17429
NotSolved
15.10.2020 23:03:09 Labyrinth
NotSolved

Ansicht des Beitrags:
Von:
Gast72393		 Datum:
15.10.2020 21:22:28		 Views:
499		 Rating:
     
Antwort:
  Ja
Thema:
... mit Beispiel dazu

Haha, ich Schussel. Habe den einfachsten Fall nicht berücksichtigt. :_)

  A B
1 Art Menge
2 1 34
4 2 7
5 3 7
6 4 18 
Option Explicit
  
Sub Test()
  
  Dim rngData As Excel.Range
  
  With Worksheets("Tabelle1")
'   Art ¦ Menge
'  -----+------
'    1  ¦  33
'    2  ¦  28
'    3  ¦  91
    Set rngData = .Range("B2:B6") 'Bereich der Werte in Spalte Menge
  End With
  
  Dim k_max As Long 'maximale Menge k
  Dim k     As Long 'Menge k
  Dim n     As Long 'Anzahl (Zeilen)
  
  k_max = 21
  
  Dim i As Long
  'von unten nach oben (!)
  For i = rngData.Cells.Count To 1 Step -1
    With rngData.Cells(i)
      k = .Value          'Menge k
      n = (k \ k_max + 1) 'Anzahl (Zeilen)
      If n > 1 Then
        'neue Zeilen einfügen
        Call .Offset(1).Resize(n - 1).EntireRow.Insert(xlShiftDown)
        'Spalte [Art]: übertrage den Wert in neue Zeilen
        .Resize(n).Offset(0, -1) = .Offset(0, -1)
        'Spalte [Menge]: setze neue Werte
        .Resize(n).Value = k \ n
        'Spalte [Menge]: ggf. Rest aufteilen
        For k = 1 To (k Mod n)
          .Offset(k - 1).Value = .Offset(k - 1).Value + 1
        Next
      End If
    End With
  Next
  
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
14.10.2020 20:00:05 Labyrinth
NotSolved
14.10.2020 21:35:57 Gast10030
NotSolved
15.10.2020 20:49:56 Labyrinth
NotSolved
15.10.2020 00:36:29 Gast72411
NotSolved
15.10.2020 00:52:26 Gast28728
NotSolved
15.10.2020 01:13:06 Gast68173
NotSolved
15.10.2020 20:59:30 Labyrinth
NotSolved
Blau ... mit Beispiel dazu
 15.10.2020 21:22:28 Gast72393
NotSolved
15.10.2020 21:25:34 Gast7567
NotSolved
15.10.2020 22:11:31 Gast7661
Solved
15.10.2020 22:16:55 Gast22247
NotSolved
15.10.2020 22:20:58 Gast17429
NotSolved
15.10.2020 23:03:09 Labyrinth
NotSolved