Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
前月分と当月分の2つのシートを項目毎に照合をしたい
投稿日時: 20/08/25 15:29:15
投稿者: たんしお

教えていただけないでしょうか。
 
当月データと前月データで金額が変わってないか照合するため、
マクロ作成して、金額が違う部分を色付けするようにしたのですが、
月によって、項目数に変動があることが判明したため、
セルで指定するだけでは、セルの位置がずれてしまい、うまく照合できませんでした。
項目名で照合することはできるのか、調べてもわかりませんでした。
 
ご教授いただきたく、宜しくお願い致します。
 
セルの位置が同じ場合だった時のマクロになります。
 
Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long
 RETSU_S = 2 '列をAから
 
 RETSU_E = 10 '列をJまで
 GYOU_S = 4 '行を4から
 GYOU_E = 20 '行を20まで
 Dim s1, s2 As Worksheet
 Set s1 = Worksheets("シート1")
 Set s2 = Worksheets("シート2")
 Dim retsu, gyou As Long
 For gyou = GYOU_S To GYOU_E
 For retsu = RETSU_S To RETSU_E
 If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou, retsu).Value Then
 '同じ位置のセルの値が等しくなければ、そのセルを赤で塗りつぶす。
 s1.Cells(gyou, retsu).Interior.Color = RGB(255, 0, 0)
 s2.Cells(gyou, retsu).Interior.Color = RGB(255, 0, 0)
 End If
 Next
 
 
 
 End Sub

回答
投稿日時: 20/08/25 15:43:32
投稿者: sk

引用:
当月データと前月データで金額が変わってないか照合

引用:
月によって、項目数に変動があることが判明

「当月データにあって前月データにはない項目」や
「前月データにあって当月データにはない項目」については
どのように扱われたいのでしょうか。
 
引用:
項目名で照合

引用:
RETSU_S = 2 '列をAから

引用:
GYOU_S = 4 '行を4から

引用:
For gyou = GYOU_S To GYOU_E

つまり、それぞれの表における列見出し行は
ワークシートの 3 行目(表の左上のセルは B3 セル)、
ということでしょうか。

投稿日時: 20/08/26 00:36:36
投稿者: たんしお

内容が不足しておりすみません。
 
それぞれの表における列見出し行はB3セルになります。
変動がある項目数は2つ程度のため、
対象データはありません等のエラーメッセージを出せたらと思っております。

回答
投稿日時: 20/08/26 09:31:19
投稿者: sk

引用:
それぞれの表における列見出し行はB3セルになります。

'列見出し行の行番号を定数として定義
Const MIDASHI_GYOU As Long = 3

Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Worksheets("シート1")
Set s2 = Worksheets("シート2")

Dim h1 As Range, h2 As Range
Dim RETSU_S As Long, RETSU_E1 As Long, RETSU_E2 As Long
Dim GYOU_S As Long, GYOU_E As Long

RETSU_S = 2 '列をAから

With s1
    's1 上の表の列見出し行の最終列の番号を取得する
    RETSU_E1 = .Cells(MIDASHI_GYOU, .Columns.Count).End(xlToLeft).Column
    's1 上の表の列見出し行に当たるセル範囲を参照
    Set h1 = .Range(.Cells(MIDASHI_GYOU, RETSU_S), .Cells(MIDASHI_GYOU, RETSU_E1))
End With

With s2
    's2 上の表の列見出し行の最終列の番号を取得する
    RETSU_E2 = .Cells(MIDASHI_GYOU, .Columns.Count).End(xlToLeft).Column
    's2 上の表の列見出し行に当たるセル範囲を参照
    Set h2 = .Range(.Cells(MIDASHI_GYOU, RETSU_S), .Cells(MIDASHI_GYOU, RETSU_E2))
End With

GYOU_S = MIDASHI_GYOU + 1 '列見出し行の次の行をデータ行の開始行とする
GYOU_E = 20               '行を20まで

Dim c1 As Range, c2 As Range
Dim RETSU_1 As Long, RETSU_2 As Long, GYOU As Long

Application.ScreenUpdating = False

'h1 の各セルを順次参照
For Each c1 In h1
    'c1 の列番号を取得
    RETSU_1 = c1.Column
    'h2 のうち、値(項目名)が c1 の値と一致するセルを検索
    Set c2 = h2.Find(What:=c1.Value, After:=h2.Cells(1), LookAt:=xlWhole)
    '見つからなかった場合
    If c2 Is Nothing Then
        '見出しセルにコメントを挿入
        c1.AddComment "[" & s2.Name & "]には存在しない項目"
    '見つかった場合
    Else
        'そのセルの列番号を取得
        RETSU_2 = c2.Column
        'データ行の先頭行から最終行までを走査
        For GYOU = GYOU_S To GYOU_E
            If s1.Cells(GYOU, RETSU_1).Value <> s2.Cells(GYOU, RETSU_2).Value Then
                '項目名が同じである列同士のセルの値が等しくなければ、そのセルを赤で塗りつぶす。
                s1.Cells(GYOU, RETSU_1).Interior.Color = RGB(255, 0, 0)
                s2.Cells(GYOU, RETSU_2).Interior.Color = RGB(255, 0, 0)
            End If
        Next
    End If
Next

'h2 の各セルを順次参照
For Each c2 In h2
    'h1 のうち、値(項目名)が c2 の値と一致するセルを検索
    Set c1 = h1.Find(What:=c2.Value, After:=h1.Cells(1), LookAt:=xlWhole)
    '見つからなかった場合
    If c1 Is Nothing Then
        '見出しセルにコメントを挿入
        c2.AddComment "[" & s1.Name & "]には存在しない項目"
    End If
Next

Application.ScreenUpdating = True

Set h2 = Nothing
Set h1 = Nothing
Set s2 = Nothing
Set s1 = Nothing

------------------------------------------------------------
 
以上のようなコードを実行なさればよろしいのではないかと。
 
引用:
変動がある項目数は2つ程度のため、
対象データはありません等のエラーメッセージを出せたらと思っております。

同じ名前の項目が検出されなかった都度
メッセージボックスが表示されるのは
鬱陶しいと思いますので、上記のコードでは
該当列の見出しセルにコメントを追記するようにしています。
 
以下は蛇足的補足。
 
たんしお さんの引用:
Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long

たんしお さんの引用:
Dim s1, s2 As Worksheet

たんしお さんの引用:
Dim retsu, gyou As Long

これらの変数は全て Variant 型であり、Long でも Worksheet でも
ありません。
(末尾の As だけで全ての変数の型を包括的に宣言できたりはしない)
 
このままでも一応動作はしますが、VBE の入力支援機能が利かない、
想定していたものとは異なる型のデータ/オブジェクトが渡されても
エラーが発生しない(結果として不具合を見逃しやすくなる)などの
弊害がありますので、その点について理解されておくことをお奨めします。

回答
投稿日時: 20/08/27 10:56:21
投稿者: WinArrow
投稿者のウェブサイトに移動

ちょっとした疑問
 
最初の質問時に
>RETSU_S = 2 '列をAから
と書かれています。
列をAから
と、
RETSU_S = 2
が矛盾しませんか?
 
※列Aのセルは、両シートの照合キーと考えますが、・・・・違っていますか?

 

投稿日時: 20/09/01 14:43:40
投稿者: たんしお

sk 様
 
返信が遅くなりすみません。
上記のコードで思っていた作業ができました。
ありがとうございます。
該当しない場合にメッセージボックスを作ったら、
セルごとに何度もでて、悩んでおりました。
コメントできるとは知りませんでした。
大変勉強になりました。
 
 
WinArrow 様
>RETSU_S = 2 '列をAから
 と書かれています。
 
 私の記載誤りです。正しくは列をBです。