日本的な表作成のためのセル結合
vbaを業務で日々書いているhiroです。今日は、私のいるドメスティックな業界で求められるセル結合のためのvbaコードをご紹介したいと思います。
twitterとかでみると、神エクセルとか馬鹿にされるセル結合ですが、これが求められるのは、紙で出力して見やすいかどうかで相手の能力を判断する、という昭和的な仕事の仕方だと思います。
それは古い!と怒るのは簡単ですが、確かに同じ文字列が並ぶデータ形式をそのまま表にしては相手は見てくれないのも事実。やはり読みやすくはない。社内、特に同じ仕事仲間であれば問題ないですが、管理職に見せると「わかりにくい」、契約の相手先に見せると「もっと見やすくしてください」と言われるのがオチ。
そのため、せっせと手動でセル結合する作業が発生する、というのがいろんな企業であるのではないでしょうか。
これがそのコードです。前提として、結合したいセルの箇所は1番上だけ文字・値があり、その他は空白である、という状態とします。
Sub merge1col(ByVal colnum As Long, ByVal aa As Long, ByVal srtrow As Long)
'1列の範囲のなかで空白セルと値のあるセルを結合する
Dim arr() As Long
Dim arr2nd() As Long
Dim chk() As Long
Dim chk2nd() As Long
Dim chksmall() As Long
Dim a As Long, b As Long, bb As Long
ReDim chk(1 To aa)
ReDim chk2nd(1 To aa)
For a = 1 To aa
If Len(Cells(srtrow - 1 + a, colnum).Value) = 0 Then
chk(a) = 0
chk2nd(a) = aa * 2
Else
chk(a) = 1
chk2nd(a) = a
End If
Next a
bb = Module10.funcsum(chk)
ReDim chksmall(1 To aa)
For a = 1 To aa
chksmall(a) = Application.WorksheetFunction.Small(chk2nd, a)
Next a
ReDim arr(1 To bb)
For b = 1 To bb
arr(b) = chksmall(b)
Next b
ReDim arr2nd(1 To bb)
For b = 1 To bb
If b = bb Then
arr2nd(b) = aa - arr(b) + 1
Else
arr2nd(b) = arr(b + 1) - arr(b)
End If
Next b
For b = 1 To bb
If arr2nd(b) > 0 Then
Cells(srtrow - 1 + arr(b), colnum).Resize(arr2nd(b), 1).Merge
End If
Next b
End Sub
代入するcolnum は列番号、aaは行数、srtrowはスタートする行という意味です。
途中の Module10.funcsum は ワークシート関数のsum だと思ってください。
途中の配列 arr2nd は結合するセル数を表しています。
また途中でSmall関数を使っているのは、セルがある行方向の番号を特定するためです。別の方法でもよいですが、1万行とかあることは考えにくいので、そのままとしています。
計算の過程としては、空白でないセルの番号を特定し、そのセルがいくつのセルを結合すべきかを計算し、その結果にあわせて、セル結合する、というものです。
これで下らない作業の効率化になればと思います。
twitterもありますので、質問がありましたら、対応したいと思います。
https://twitter.com/VbaHiro1219
この記事が気に入ったらサポートをしてみませんか?