Excel VBA質問箱 IV

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

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


46586 / 76736 ←次へ | 前へ→

【35120】Re:差分ファイルの作成
発言  ponpon  - 06/2/21(火) 21:11 -

引用なし
パスワード
   こんばんは。
同じ質問なら、前のレスに続けた方が良かったかも?

シートで考えてみたので参考にしてください。

シート1A列にデータ
シート2A列にデータ

両A列を比較して違うものがあったら、A列にシート1の値を、B列にシート2の値を
新しくシートを作り書き出します。
ただし、各A列には重複がないものとします。

ブックにはシート1とシート2しかないものとします。(あってもかまいませんが)

Sub test()
  Dim Sh1 As Worksheet
  Dim Sh2 As Worksheet
  Dim NewSh As Worksheet
  Dim myRow1 As Long
  Dim myRow2 As Long
  Dim myCnt As Long
  Dim myVal1 As Variant
  Dim myVal2 As Variant
  Dim myDic As Object
  Dim i As Long
 
  Set Sh1 = Sheets("Sheet1")
  Set Sh2 = Sheets("Sheet2")
  Set myDic = CreateObject("Scripting.Dictionary")
 
  myRow1 = Sh1.Range("A65536").End(xlUp).Row
  myRow2 = Sh2.Range("A65536").End(xlUp).Row
  
  If myRow1 >= myRow2 Then
   myCnt = myRow1
  Else
   myCnt = myRow2
  End If
 
  myVal1 = Sh1.Range("A1").Resize(myCnt).Value
  myVal2 = Sh2.Range("A1").Resize(myCnt).Value
   
  For i = 1 To myCnt
    If myVal1(i, 1) <> myVal2(i, 1) Then
     myDic(myVal1(i, 1)) = myVal2(i, 1)
    End If
  Next
 
  Set NewSh = Sheets.Add(after:=Sheets(Sheets.Count))
  With NewSh.Range("A1").Resize(myDic.Count)
    .Value = Application.Transpose(myDic.keys)
    .Offset(, 1).Value = Application.Transpose(myDic.Items)
  End With
  Set Sh1 = Nothing: Set Sh2 = Nothing: Set myDic = Nothing: Set NewSh = Nothing
 
End Sub
0 hits

【35117】差分ファイルの作成 ビギナー 06/2/21(火) 19:46 質問
【35118】Re:差分ファイルの作成 BB 06/2/21(火) 20:41 発言
【35120】Re:差分ファイルの作成 ponpon 06/2/21(火) 21:11 発言

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