Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9781 / 76734 ←次へ | 前へ→

【72511】Re:明細の再確認
発言  UO3  - 12/8/18(土) 11:12 -

引用なし
パスワード
   ▼杏子 さん:

こんにちは

資料Aも資料Bも,マクロブックのシートに貼り付けてあるという前提です。
比較後、相違をメッセージで表示します。

Sub Sample()
  Dim shA As Worksheet
  Dim shB As Worksheet
  Dim x As Double
  Dim y As Double
  Dim rA As Range, rB As Range
  Dim i As Long
  Dim j As Long
  Dim v() As String
  Dim k As Long
  Dim dataA As Variant
  Dim dataB As Variant
  
  Set shA = Sheets("Sheet1") '資料A
  Set shB = Sheets("Sheet2") '資料B
  
  With shA.UsedRange
    x = .Cells(.Cells.Count).Column
    y = .Cells(.Cells.Count).Row
  End With
  
  With shB.UsedRange
    x = WorksheetFunction.Max(x, .Cells(.Cells.Count).Column)
    y = WorksheetFunction.Max(y, .Cells(.Cells.Count).Row)
  End With
    
  Set rA = shA.Range("A2", shA.Cells(y, x))
  Set rB = shB.Range("A2", shB.Cells(y, x))
  
  ReDim v(1 To rA.Count)
  
  For i = 1 To rA.Rows.Count
    For j = 1 To rA.Columns.Count
      If shA.Cells(i, j).Formula <> shB.Cells(i, j).Formula Then
        k = k + 1
        dataA = shA.Cells(i, j).Formula
        dataB = shB.Cells(i, j).Formula
        If Len(dataA) = 0 Then dataA = "空白値"
        If Len(dataB) = 0 Then dataB = "空白値"
        
        v(k) = shA.Cells(i, j).Address(False, False) & " (A) " & dataA & " vs (B) " & dataB
      End If
    Next
  Next
  
  If k = 0 Then
    MsgBox "相違はありません"
  Else
    ReDim Preserve v(1 To k)
    MsgBox "以下の相違がありました" & vbLf & Join(v, vbLf)
  End If
      
End Sub

2 hits

【72509】明細の再確認 杏子 12/8/18(土) 9:20 質問
【72511】Re:明細の再確認 UO3 12/8/18(土) 11:12 発言
【72512】Re:明細の再確認 杏子 12/8/18(土) 15:31 質問
【72515】Re:明細の再確認 UO3 12/8/18(土) 20:54 発言
【72516】Re:明細の再確認 杏子 12/8/19(日) 13:12 発言
【72517】Re:明細の再確認 UO3 12/8/19(日) 14:41 発言
【72518】Re:明細の再確認 杏子 12/8/19(日) 15:02 発言
【72520】Re:明細の再確認 UO3 12/8/19(日) 16:15 発言
【72521】Re:明細の再確認 杏子 12/8/19(日) 16:27 発言
【72523】Re:明細の再確認 UO3 12/8/19(日) 17:25 発言
【72524】Re:明細の再確認 杏子 12/8/19(日) 17:32 発言
【72525】Re:明細の再確認 UO3 12/8/19(日) 17:34 発言
【72527】Re:明細の再確認 杏子 12/8/19(日) 18:58 発言
【72528】Re:明細の再確認 UO3 12/8/19(日) 19:17 発言
【72529】Re:明細の再確認 杏子 12/8/19(日) 19:30 発言
【72533】Re:明細の再確認 杏子 12/8/20(月) 9:32 発言
【72536】Re:明細の再確認 UO3 12/8/20(月) 12:18 発言
【72537】Re:明細の再確認 杏子 12/8/21(火) 6:23 質問
【72538】Re:明細の再確認 杏子 12/8/21(火) 10:37 質問
【72539】Re:明細の再確認 UO3 12/8/21(火) 11:49 発言
【72540】Re:明細の再確認 杏子 12/8/21(火) 12:14 質問
【72541】Re:明細の再確認 UO3 12/8/21(火) 17:48 発言
【72542】Re:明細の再確認 UO3 12/8/21(火) 20:40 発言
【72543】Re:明細の再確認 杏子 12/8/21(火) 21:14 お礼
【72544】Re:明細の再確認 杏子 12/8/21(火) 22:42 質問
【72546】Re:明細の再確認 UO3 12/8/22(水) 0:50 発言
【72548】Re:明細の再確認 杏子 12/8/22(水) 6:26 質問
【72549】Re:明細の再確認 UO3 12/8/22(水) 13:59 発言
【72551】Re:明細の再確認 杏子 12/8/22(水) 15:19 お礼

9781 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free