Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4490 / 76733 ←次へ | 前へ→

【77865】Re:規定数で区切るには
発言  β  - 16/1/15(金) 10:12 -

引用なし
パスワード
   ▼karasu さん:

一例です。
勘違いあれば指摘願います。

Sub test()
  DivItem 10
End Sub

Sub DivItem(cnt As Long)
  Dim c As Range
  Dim box As Long
  Dim qtyIn As Long
  Dim qtyBlc As Long
  Dim qtySet As Long
  Dim w As Variant
  Dim dic As Object
  
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
    If c.Row <> 1 Then
      qtyIn = c.EntireRow.Range("C1").Value
      qtyBlc = qtyIn
      Do
        If cnt - box >= qtyBlc Then
          qtySet = qtyBlc
        Else
          qtySet = cnt - box
        End If
        
        qtyBlc = qtyBlc - qtySet
        w = c.EntireRow.Range("A1:C1").Value
        w(1, 3) = qtySet
        dic(dic.Count) = w
        
        box = box + qtySet
        If box = cnt Then box = 0
        
      Loop While qtyBlc > 0
    End If
  Next
    
              
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    .Range("A1:C1").Value = Sheets("Sheet1").Range("A1:C1").Value
    .Range("A2").Resize(dic.Count, 3).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
    With .Range("D2").Resize(dic.Count)
      .Formula = "=IF(MOD(SUM(C$2:C2)," & cnt & "),MOD(SUM(C$2:C2)," & cnt & ")," & cnt & ")"
      .Value = .Value
    End With
    .Select
  End With
    
End Sub

1 hits

【77864】規定数で区切るには karasu 16/1/15(金) 6:13 質問[未読]
【77865】Re:規定数で区切るには β 16/1/15(金) 10:12 発言[未読]
【77866】Re:規定数で区切るには ウッシ 16/1/15(金) 10:42 回答[未読]
【77869】Re:規定数で区切るには karasu 16/1/16(土) 3:38 お礼[未読]
【77871】Re:規定数で区切るには γ 16/1/16(土) 8:44 発言[未読]
【77874】Re:規定数で区切るには karasu 16/1/16(土) 13:08 回答[未読]
【77879】Re:規定数で区切るには γ 16/1/16(土) 23:52 発言[未読]
【77880】Re:規定数で区切るには karasu 16/1/17(日) 2:10 お礼[未読]
【77873】Re:規定数で区切るには ウッシ 16/1/16(土) 9:08 回答[未読]
【77875】Re:規定数で区切るには karasu 16/1/16(土) 13:19 お礼[未読]

4490 / 76733 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free