【vba】参考プログラ厶 グループ化を約数でします

グループ化を約数でします

Sub group1_Click()
Dim cnt As Long, cntm As Long, hikaku As Long
Dim groupRow As Long, groupSuu As Long, groupUp As Long
Dim i As Long, j As Long, k As Long, b As Long, g As Long '繰り返し用
Dim ave As Double
Dim rowsData As Long '行数カウント用の変数

rowsData = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row '最後の行数を取得

'MsgBox "最終行  " & rowsData & "  です"

'##カウント（平均求める）
hikaku = Cells(2, 2)
For i = 2 To rowsData
    If Cells(i, 2) = hikaku Then
        cnt = cnt + 1
       
        Else:
        'MsgBox "件数は  " & cnt & "  です"
        Cells(i - 1, 3) = cnt
        hikaku = Cells(i, 2)
        cnt = 1
        End If
       
Next i
    Cells(i - 1, 3) = cnt
   
'##平均
Cells(25, 9) = Application.WorksheetFunction.Average(Range("C2:C24"))
ave = Cells(25, 9)
'MsgBox "グループ平均件数は  " & ave & "  です"


'##カウント（空白埋める）
cnt = Cells(rowsData, 3)

For i = 0 To rowsData - 2
 
    If Cells(rowsData - i, 3) = "" Then
        Cells(rowsData - i, 3) = cnt
    End If
   
    If Cells(rowsData - i, 3) <> cnt And Cells(rowsData - i, 3) <> "" Then
    cnt = Cells(rowsData - i, 3)
    End If
   
Next i


'##グループ化

groupRow = 1 'グループ番号
b = 0
g = 0

For i = 2 To rowsData
cnt = Cells(i, 3)
'MsgBox "件数は  " & cnt & "  です"

 
'##分割しない
 If (Cells(i, 3) < ave And Cells(i, 3) <> Cells(i - 1, 3)) Then Cells(i, 1) = groupRow
 

'##分割する 先頭
If (Cells(i, 3) > ave) And Cells(i, 3) <> Cells(i - 1, 3) Then
    bunkatu = WorksheetFunction.RoundUp((cnt / ave), 0) '小数点以下切り上げ
    MsgBox "" & bunkatu & "分割です"
    groupSuu = WorksheetFunction.RoundUp((cnt / bunkatu), 0)
 

        If b < bunkatu And g = 0 Then
        groupRow = groupRow + 1
        b = b + 1
        End If
       
       
        If g < groupSuu Then
        Cells(i, 1) = groupRow
        g = g + 1
        Else
        g = 0
        End If
       
 End If
 
 '##分割する　先頭以降
 If (Cells(i, 3) > ave) And Cells(i, 3) = Cells(i - 1, 3) Then
 
        If b < bunkatu And g = groupSuu Then
        groupRow = groupRow + 1
        b = b + 1
        End If
       
       
        If g <= groupSuu Then
        Cells(i, 1) = groupRow
        g = g + 1
        Else
        g = 0
        End If
 
 
 End If
 

Next i






'groupRow = 1 'グループ番号
'For i = 2 To rowsData
'cnt = Cells(i, 3)
''MsgBox "件数は  " & cnt & "  です"
'
'
'   '分割しない（繰り上げながらグループNOを入力）
'    If cnt <= ave And Cells(i, 3).Value <> "" Then
'     Cells(i, 1) = groupRow
'    End If
'
'
'    '分割する（繰り上げながらグループNOを入力）
'    If cnt > ave Then
'
'     bunkatu = WorksheetFunction.RoundUp((cnt / ave), 0) '小数点以下切り上げ
'     MsgBox "" & bunkatu & "分割です"
'
'     For j = 1 To bunkatu
'
'         If j = 1 Then
'         groupRow = groupRow + bunkatu 'グループの通しNO
'         groupSuu = WorksheetFunction.RoundUp((cnt / bunkatu), 0)
'         groupUp = i + 1  '今の位置を一時保存する
'         End If
'
'         For k = 1 To groupSuu
'          'If groupUp = i - cnt + 1 Then Exit For
'          Cells(groupUp - k, 1) = groupRow
'         Next k
'
'
'            groupUp = groupUp - k + 1
'
'            If groupUp = i - cnt + 1 Then
'            groupRow = groupRow + bunkatu - 1
'            Exit For '割り切れないあまり時
'            End If
'
'         groupRow = groupRow - 1
'
'     Next j
'
'    groupRow = groupRow + 1
'    End If
'
'
'Next i
       
 

'MsgBox "グループ完了"


End Sub