VBA100本ノック12本目：セル結合を解除

excel-ubara.com

出題内容

#VBA100本ノック 12本目
A1から始まる表範囲のC列に金額が入っています。
しかし、ところどころに結合されたセルがあります。
セル結合を解除し、入っている金額を整数で均等に割り振ってください。（2枚目画像）
端数処理方法は任意とします。
※結合セルには正の整数しか入っていません。

自分の解答

Sub vba12()

　Dim rng As Range
　Dim val As Variant

　For Each rng In Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)

　　If rng.MergeCells Then
　　　val = rng.Value

　　　With rng.MergeArea
　　　　.UnMerge
　　　　.Value = val / .Count
　　　End With

　　End If

　Next rng

End Sub

 .Value = val / .Count　としている為、割り算の結果がそのまま各セルに入力される。

小数点ではなく整数で入力したい。

修正

Sub vba12()

　Dim rng As Range
　Dim val As Variant
　Dim i As Long

　For Each rng In Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)

　　If rng.MergeCells Then
　　　val = rng.Value

　　　With rng.MergeArea
　　　　.UnMerge
　　　　i = Int(val / .Count)
　　　　.Value = i
　　　　rng(1) = rng(1) + val - (i * .Count)
　　　End With

　　End If

　Next rng

End Sub

 Intで切り捨てた後にあまりをrng(1)に足す。

余りが大きい場合はrng(1)のズレも大きくなってしまう。