Excel VBA質問箱 IV

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

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


4491 / 76735 ←次へ | 前へ→

【77866】Re:規定数で区切るには
回答  ウッシ  - 16/1/15(金) 10:42 -

引用なし
パスワード
   こんにちは

Sub test()
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim wsh As Worksheet
  Dim r  As Range
  Dim s  As Range
  Dim i  As Long
  Dim j  As Long
  Const m As Long = 3  '規定数
  
  Set sh1 = Worksheets("Sheet1")
  Set sh2 = Worksheets("Sheet2")
  Set wsh = Worksheets.Add
  
  Application.ScreenUpdating = False
  
  sh2.UsedRange.Offset(1).ClearContents
  
  wsh.Range("A1:C1").Value = sh1.Range("A1:C1").Value
  wsh.Range("D1").Value = "グループ"
  
  i = 2
  For Each r In sh1.Range("A2", sh1.Range("A2").End(xlDown))
    wsh.Cells(i, 1).Resize(r(1, 3), 3).Value = r.Resize(, 3).Value
    i = i + r(1, 3)
  Next
  
  j = wsh.Range("A" & Rows.Count).End(xlUp).Row
  With wsh.Range("D2:D" & j)
    .Formula = "=B2&INT((ROW()+" & m - 2 & ")/" & m & ")"
    .Value = .Value
  End With
  
  
  wsh.Range("A1").CurrentRegion.Subtotal _
    GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  
  Set s = wsh.Range("D2", wsh.Range("D2").End(xlDown).Offset(-1, 0)) _
          .Offset(, -3).SpecialCells(xlCellTypeBlanks)
  
  For Each r In s
    r.Offset(-1, 0).Resize(, 2).Copy _
      sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    sh2.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
      r.Offset(0, 2).Value
  Next

  With sh2.Range("C2", sh2.Range("C2").End(xlDown)).Offset(0, 1)
    .Formula = "=IF(D1=" & m & ",C2,D1+C2)"
    .Value = .Value
  End With
  
  Application.DisplayAlerts = False
  wsh.Delete
  Application.DisplayAlerts = True
  
  Application.ScreenUpdating = True

End Sub
0 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 お礼[未読]

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