Excel VBA質問箱 IV

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

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


8105 / 13644 ツリー ←次へ | 前へ→

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

【35117】差分ファイルの作成
質問  ビギナー  - 06/2/21(火) 19:46 -

引用なし
パスワード
   皆様、こんばんは。

ponpon様、ご指摘ありがとうございます。

もう一度、質問させていただきます。

<book1>   <book2>
1       1
2       a
3       b
4       4
5       5
6       7
7

たとえば、このようにbook1と2の2つのファイルがあるとします。
この2つを行単位で比較して、

<book3>
2  a
3  b
5  5
6  7
7

というように、差分だけを示したbook3を新規でデスクトップに作成したいのです。
NoEditorというフリーソフトの高度なDiff機能(順番まで把握してくれる)は、VBAにもあるのでしょうか?

よろしくお願いいたします。

【35118】Re:差分ファイルの作成
発言  BB  - 06/2/21(火) 20:41 -

引用なし
パスワード
   ▼ビギナー さん:
>皆様、こんばんは。
>
>ponpon様、ご指摘ありがとうございます。
>
>もう一度、質問させていただきます。
>
><book1>   <book2>
>1       1
>2       a
>3       b
>4       4
>5       5
>6       7
>7
>
>たとえば、このようにbook1と2の2つのファイルがあるとします。
>この2つを行単位で比較して、
>
><book3>
>2  a
>3  b
>5  5
>6  7
>7
>
>というように、差分だけを示したbook3を新規でデスクトップに作成したいのです。
>NoEditorというフリーソフトの高度なDiff機能(順番まで把握してくれる)は、VBAにもあるのでしょうか?
>
>よろしくお願いいたします。

まず、エクセルVBAで一発で拾い出すような機能はないと思います。(たぶん)
ただVBAで作成することは可能です。

ループ(Do〜Loop、For〜Next)と比較(If Then)とコピー&ペーストが分かればできるんじゃないですかね?
ビギナーということで、どこまで自分で作成されているのかを提示されては?
何も自分で作ってなければ「ビギナー」ではなく「何もしてない者」ということですもんね。

ただ、book3を新規でテスクトップに作成っていうのが、デスクトップのパスのとり方がOSによって違う気がします。

【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

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