Excel VBA質問箱 IV

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

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


64429 / 76732 ←次へ | 前へ→

【16884】Re:ブックの比較
回答  Hirofumi  - 04/8/14(土) 15:07 -

引用なし
パスワード
   >>vntSheet1、vntSheet2のIDがMatchした場合、各列の値を比較し違っている時
>IDをkeyにしていますが、選択で文字もID同様にMatchしています。
>文字の場合も同様のやり方(現在、作成中)で宜しいのでしょうか。

文字の場合も同様のやり方で出来ます
ただ、今回の様に、比較する文字列の有る列が、比較する文字列をKeyとして
Sheet1、Sheet2共に昇順にソートされているのが条件です
また、「Option Compare Text」を必ず入れて下さい
Excelでソートした場合、此れを入れないと、コードの比較順と結果が変わりますので

>>また、「fncGetSheetData」のデータ取得方法が善く解らない為、
>他のデータ(文書等)もあり、空白行・列など大量にある為、
>シート全体に対し、最終行・列を取得しています。

>>各Bookのデータは、A1から有る物としてCurrentRegionで取得しています
>項目行も変更対象なので、比較対照にしています。

「Function fncGetSheetData」は、中を替えていますが
インターファイスは替えていない為、どんばさん本来のコードでも
ソートの部分を追加すれば使えると思います

>Sheet3にMatchしないセルに色を塗りたいのですが、
>最後にメッセージにてMatchしないセルに色を塗るか選択したい為、
>どの様にしたら宜しいでしょうか。

この部分の修正は、以下の様に成ります

「Sub Test7」の中で

  Dim blnNoMatch As Boolean
  Dim j As Long        '◎追加
  Dim vntNoMatch() As Variant '◎追加
  Dim blnPaint As Boolean   '◎追加


  'Matchしないセルの色塗り選択  ◎追加
  If MsgBox("Matchしないセルに色を塗ります", _
      vbInformation + vbYesNo, "Paint") = vbYes Then '◎追加
    blnPaint = True '◎追加
  End If '◎追加
  
  '"D:\test1.xls"からのデータ取得
  If Not fncGetSheetData(vntSheet1, lngSh1Row, _
                lngSh1Cln, "Sheet1") Then


      '列側のデータの比較
      blnNoMatch = False
      j = 0                      '◎追加
      For i = 1 To lngSh2Cln
        If vntSheet1(lngSh1Pos, i) _
              <> vntSheet2(lngSh2Pos, i) Then
          blnNoMatch = True
          j = j + 1                '◎追加
          ReDim Preserve vntNoMatch(1 To j)    '◎追加
          vntNoMatch(j) = i - 1          '◎追加
'          Exit For                '★削除
        End If
      Next i
      'データが一致しない場合
      If blnNoMatch Then
        'Sheet3に行データを書き込み
        ResultWrite vntSheet2, lngSh2Pos, _
              lngSh2Cln, wksSheet3, lngSh3Row
        If blnPaint Then               '◎追加
          PaintingInterior vntNoMatch, _
                    wksSheet3, lngSh3Row '◎追加
        End If                    '◎追加
      End If


以下のプロシージャを追加

Private Sub PaintingInterior(vntColor As Variant, _
              wksWrite As Worksheet, _
              lngWriteRow As Long)

'  セルの色塗り

  Dim i As Long
  
  With wksWrite.Cells(lngWriteRow, 1)
    For i = 1 To UBound(vntColor)
      .Offset(-1, vntColor(i)).Interior.ColorIndex = 34
    Next i
  End With

End Sub


PS:
 話は変わりますが、どんばさんが最初に書いたコード
 私のコードを下敷きにしていますか?
 某所のレスも見ましたが、コメントの付け方、変数名等が、
 私のコードの雰囲気にソックリな物で?
1 hits

【16851】ブックの比較 どんば 04/8/11(水) 22:27 質問
【16858】Re:ブックの比較 Hirofumi 04/8/12(木) 10:50 回答
【16878】Re:ブックの比較 どんば 04/8/14(土) 12:48 質問
【16884】Re:ブックの比較 Hirofumi 04/8/14(土) 15:07 回答
【16891】Re:ブックの比較 どんば 04/8/14(土) 18:32 お礼

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