★★★★★★Access2000VBA・Excel2000VBA独学～結合セルの最初のセルと最後のセルのアドレス（番地）を調べる自作関数～請求書の「明細データ」などの、「結合されたセルを持つ帳票」のセルデータをテーブルデータなどに整形・クレンジング（？）するときなどに。～
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
※関連記事
『 ★★★★★★Access2000VBA・Excel2000VBA独学～例えば、セル結合もある、「３行単位で１レコード」の帳票を、１行１レコードの一覧表に変換する若干汎用的なプログラム～ 』
★ はじめに
例えば請求書などで、明細内容が、テーブル形式（リスト形式）ではなく、データの並びが「自由」な「帳票形式」で書かれて、送られてくる場合があります。
例えば下図のような。
このようなデータを、VBAなどでテーブル形式（リスト形式）に別の場所に整形して転記したい場合、セル結合が多く使われていますので少々面倒になると思います。
セル結合が一切なければ、For Each 文だけで比較的ラクに処理できそうな気がしますが、セル結合がバンバンに入っていますと、For Each 文だけでは少々難しいです。
で、そのような場合に（For Each 文ですべてのセルを回したときに）、
・そもそも今チェックしているセルは結合されているのかどうか？
・結合されているなら、どこからどこまでの結合に含まれるか？
などが判定できると便利です。
困るのは、
・結合されているかいないかを空白セルかどうかで判定してしまったとき
で、かつ、
・空白セルなら処理を飛ばす（つまり、何もしない。）
みたいにしてしまったときです。
それをやってしまうと、上図の「単位」や「備考」のように値を持っていないセルが、「空白セルとして転記」されず、「なかったもの」と『 誤判断 』されて、転記結果の列や行に「ズレ」が生じることがあります。
そのようなことを回避するために、
・そもそも今チェックしているセルは結合されているのかどうか？
・結合されているなら、どこからどこまでの結合に含まれるか？
が必要になってくると思います。
結合されたセルの場合、「結合された先頭のセル」に値を入力することになりますので、
・今チェックしているセルのアドレスが、結合セルの先頭セルと同じアドレスなら、値が空でも転記する、
というような条件分岐が作れると思います。
結果、転記先の列や行が「ガタガタ」になることを防げると思いますし、For Each が使えるケースも少し増えて、プログラミングが少しラクになる気がします。
本記事はそのようなときのために使う、自作関数のご紹介です。
プログラム内容としては、以降に示したようなかたちです。
例えば「GetMrgCelAddr_Fst()」関数の場合なら
GetMrgCelAddr_Fst(Range("A1"))
のように使います。
このとき、「Range("A1")」の部分は、For Each でセル範囲を走査したいときなら、単一セルを受けるオブジェクト変数でもOKです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 |
' ' '################################################################# '結合セルの先頭セルのアドレスを取得する自作関数 '################################################################# Function GetMrgCelAddr_Fst(o_SingleCel As Range) As String Dim s_MargAddr As String If o_SingleCel.MergeCells = True Then s_MargAddr = o_SingleCel.MergeArea.Address GetMrgCelAddr_Fst = LTrimWrd(s_MargAddr, ":") Else GetMrgCelAddr_Fst = "NonMrg" End If End Function '################################################################# '結合セルの最後のセルのアドレスを取得する自作関数 '################################################################# Function GetMrgCelAddr_End(o_SingleCel As Range) As String Dim s_MargAddr As String If o_SingleCel.MergeCells = True Then s_MargAddr = o_SingleCel.MergeArea.Address GetMrgCelAddr_End = RTrimWrd(s_MargAddr, ":") Else GetMrgCelAddr_End = "NonMrg" End If End Function '################################################################# '特定の、指定した文字を境に、その左側の文字列を切り出す自作関数 '今回は「$A$1:$C$1」のようなセル範囲の「:」よりも左のアドレスを '取得するのに使います '################################################################# Function LTrimWrd(s_Wrd01 As String, s_DlmtChr01 As String) As String Dim i_DlmtPos As Integer i_DlmtPos = InStr(1, s_Wrd01, s_DlmtChr01, vbBinaryCompare) LTrimWrd = Left(s_Wrd01, i_DlmtPos - 1) End Function '################################################################# '特定の、指定した文字を境に、その右側の文字列を切り出す自作関数 '今回は「$A$1:$C$1」のようなセル範囲の「:」よりも右のアドレスを取得 'するのに使います '################################################################# Function RTrimWrd(s_Wrd02 As String, s_DlmtChr02 As String) As String Dim i_DlmtPos02 As Integer Dim l_WdLen01 As Integer l_WdLen01 = Len(s_Wrd02) i_DlmtPos02 = InStr(1, s_Wrd02, s_DlmtChr02, vbBinaryCompare) RTrimWrd = Right(s_Wrd02, l_WdLen01 - i_DlmtPos02) End Function ' ' |
★ この関数を作る前のテストコード（現況調査コード）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
' ' Sub test() Dim aaaa As Range For Each aaaa In Range("B4:H5") If aaaa.MergeCells Then ' Debug.Print aaaa.Address & "は結合されています。 If aaaa.Value <> "" Then Debug.Print aaaa.Address & "は結合されています。" & aaaa.MergeArea.Address & "。値は「" & aaaa.Value & "」です。" Else Debug.Print aaaa.Address & "は結合されています。" & aaaa.MergeArea.Address & "。値は空です。" End If Else Debug.Print aaaa.Address & "は結合されていません。" End If Next aaaa End Sub ' ' '以下のようにイミディエイトウィンドウに表示されます。 $B$4は結合されていません。 $C$4は結合されています。$C$4:$E$4。値は「大型ダイニングテーブル」です。 $D$4は結合されています。$C$4:$E$4。値は空です。 $E$4は結合されています。$C$4:$E$4。値は空です。 $F$4は結合されています。$F$4:$H$4。値は「D-R-S56」です。 $G$4は結合されています。$F$4:$H$4。値は空です。 $H$4は結合されています。$F$4:$H$4。値は空です。 $B$5は結合されていません。 $C$5は結合されていません。 $D$5は結合されていません。 $E$5は結合されていません。 $F$5は結合されています。$F$5:$H$5。値は空です。 $G$5は結合されています。$F$5:$H$5。値は空です。 $H$5は結合されています。$F$5:$H$5。値は空です。 |
★ GetMrgCelAddr_Fst関数とLTrimWrd関数を使って、明細の値をイミディエイトに表示する例
（冒頭の図の場合。）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 |
' ' Sub test002() Dim aaaa As Range Dim i As Long Dim l_interval As Long i = 1 l_interval = 14 Debug.Print "===============" '指定範囲のすべてのセルをチェック。 For Each aaaa In Range("B2:H11") 'ひとまとまりごとに区切り線を表示。 If i Mod l_interval = 0 Then Debug.Print "===============" If aaaa.MergeCells = True Then '結合セルの場合、以下のIF文の処理。 If aaaa.Address = GetMrgCelAddr_Fst(aaaa) Then '結合セルのなかにおいて、先頭セルなら値を表示。 Debug.Print aaaa.Value Else '結合セルのなかにおいて、先頭セルじゃないなら何もしない。 End If Else '結合セルじゃない場合、必ず明細のいち項目なので、 '空白だとしても必ず値を表示。 Debug.Print aaaa.Value End If i = i + 1 Next aaaa End Sub ' ' ' ' '以下のようにイミディエイトウィンドウに表示されます =============== 商品ID 品名 型番 数量 単位 単価 単価合計 備考 =============== 00115 大型ダイニングテーブル D-R-S56 1 台 50000 50000 =============== 08905 ロッキングチェア L-CHR-20 5 個 25000 125000 =============== 12312 液晶TV設置台 MT-300 1 個 50000 50000 10月19日以降納品 =============== 00756 値引き 1 -1000 -1000 =============== |
- 投稿タグ
- 「ニセモノ」への道, 「本物」に近づくために, AccessVBA, Accessの独学, Access操作の基礎, Accesの独学, ADO／DAO, ExcelSQL, ExcelVBA, Excelの独学, Excel操作の基礎, Excel連携VBA, MicrosoftQuery, ODBC, SQL, パソコンでの自動化, ビジネスパソコンの基礎, ビジネス一般常識, マクロ, ワークシート関数, 独学, 自動化
