Excel VBA質問箱 IV

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

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


17315 / 76732 ←次へ | 前へ→

【64873】VBAで業務を自動化できました(解決)
お礼  電池切れ  - 10/3/23(火) 0:04 -

引用なし
パスワード
   長らく置き去りにして居りましたが、解決致しました。
参考に成る方もいらっしゃればと思い、下記に記載をさせて頂きます。

> 上記の図の様に結果を確認したいと思っております。
> 実際には、上記の図の更に左に比較元と成っているデータが表示されて、
> 右側に比較先と成っているデータ(これをdiffの出力から取込みたいです)
> が上記の図の様に成っている事が望ましいのです。
> 対比も視覚的に見たい為、同一のシートが望ましいです。

解決しましたので、報告します。

Diff.csv

Battery,12345,denchi
CCCC111,56789,dddddd
EEEE222,01234,ffffff

Data.csv

Battery,12345,denchi
CCCCCCC,56789,dddddx
EEEEEEE,01234,fffffx

という2つのCSVファイルがあるものとします。

Data.csv をExcelシートを以下のように読み込みます。

   A   B   C 
1 Battery 12345 denchi
2 CCCCCCC 56789 dddddx
3 EEEEEEE 01234 fffffx
4

そのあと、
Diff.csv
を読み込んで、上記のシートの各セルと対比させ、以下のようにしたかった
のです。

   A   B   C  D   E   F  G  H  I  J K
1 Battery 12345 denchi  Battery ○ 12345 ○ denchi ○
2 CCCCCCC 56789 dddddx  CCCC111 × 56789 ○ dddddd ×
3 EEEEEEE 01234 fffffx  EEEE222 × 01234 ○ ffffff ×
4

つまり、Diff出力.csvの各行をSplit関数でカンマ区切りで各カラムに分けて、
そして、ExcelシートのA1セルと、Diff.csv の1行目の1カラム目と対比させ、
一致していればF1セルのように ○、一致していなければ × とし、
A〜C列は、Data.csv より、E列、G列、I列は、Diff出力.csvより読み込むと
いうことです。

なお、Diff出力.csv の列方向は、Data.csv と項目としては、同じですが、
行方向は、順不同になっていますし、A列と1カラム目は、一致しないものもあ
ります。

このような前提で作成したコードは、以下のようになりました。

Sub Sample()
 Dim strFileName(1) As String
 Dim WS As Worksheet
 Dim i As Long
 Dim io As Integer
 Dim strRec As String
 Dim v As Variant
 Dim dic As Object
 Dim x As Long, xx As Long
 Dim lngRowMax As Long
 Dim blnCk As Boolean
 Dim t As Single
 
 strFileName(0) = Application.GetOpenFilename("テキストファイル,*.csv", , "Dataファイルを選択してください")
 If strFileName(0) = "False" Then
  MsgBox "処理を中止します"
  Exit Sub
 End If
 
 strFileName(1) = Application.GetOpenFilename("テキストファイル,*.csv", , "Diff出力ファイルを選択してください")
 If strFileName(1) = "False" Then
  MsgBox "処理を中止します"
  Exit Sub
 End If
 
 t = Timer
  
 ReDim vv(1 To 65536, 1 To 10)
 Set dic = CreateObject("Scripting.Dictionary")
 
 x = 0
 io = FreeFile
 Open strFileName(0) For Input As io
 blnCk = True
 Do Until EOF(io)
  Line Input #io, strRec
  v = Split(strRec, ",")
  x = x + 1
  vv(x, 1) = v(0)
  vv(x, 2) = v(1)
  vv(x, 3) = v(2)
 Loop
 Close io
 
 lngRowMax = x
 
 x = 0
 io = FreeFile
 Open strFileName(1) For Input As io
 Do Until EOF(io)
  Line Input #io, strRec
  v = Split(strRec, ",")
  If Not dic.Exists(v(0)) Then
   x = x + 1
   dic.Add v(0), x
  End If
  xx = dic(v(0))
  vv(xx, 5) = v(0)
  vv(xx, 7) = v(1)
  vv(xx, 9) = v(2)
 Loop
 Close io
 Set dic = Nothing
 
 If lngRowMax < x Then
  lngRowMax = x
 End If
 blnCk = True
 For x = 1 To lngRowMax
  If vv(x, 1) = vv(x, 5) Then
   vv(x, 6) = "○"
  Else
   vv(x, 6) = "×"
   blnCk = False
  End If
  If CStr(vv(x, 2)) = CStr(vv(x, 7)) Then
   vv(x, 8) = "○"
  Else
   vv(x, 8) = "×"
   blnCk = False
  End If
  If vv(x, 3) = vv(x, 9) Then
   vv(x, 10) = "○"
  Else
   vv(x, 10) = "×"
   blnCk = False
  End If
 Next
 
 Workbooks.Add xlWBATWorksheet
 Set WS = ActiveSheet
 
 With WS.Range("A1").Resize(x, 10)
  .NumberFormatLocal = "@"
  .Value = vv
  .EntireColumn.AutoFit
 End With
 
 If blnCk Then
  MsgBox "処理を終了しました。相違点なし" & vbCrLf & "処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss"), vbInformation
 Else
  MsgBox "処理を終了しました。相違点あり" & vbCrLf & "処理時間 " & Format((Timer - t) / 60 / 60 / 24, "h:mm:ss"), vbInformation
 End If
End Sub
1 hits

【64706】VBAで業務を自動化したい 電池切れ 10/3/9(火) 22:19 質問
【64707】Re:VBAで業務を自動化したい かみちゃん 10/3/9(火) 22:38 発言
【64708】Re:VBAで業務を自動化したい 電池切れ 10/3/9(火) 22:45 発言
【64709】Re:VBAで業務を自動化したい かみちゃん 10/3/9(火) 22:51 発言
【64710】Re:VBAで業務を自動化したい 電池切れ 10/3/9(火) 23:10 発言
【64711】Re:VBAで業務を自動化したい かみちゃん 10/3/9(火) 23:34 発言
【64712】Re:VBAで業務を自動化したい 電池切れ 10/3/9(火) 23:43 発言
【64713】Re:VBAで業務を自動化したい かみちゃん 10/3/9(火) 23:49 発言
【64715】Re:VBAで業務を自動化したい 超初心者 10/3/10(水) 9:32 発言
【64736】Re:VBAで業務を自動化したい 電池切れ 10/3/10(水) 18:37 発言
【64735】Re:VBAで業務を自動化したい 電池切れ 10/3/10(水) 18:00 発言
【64739】Re:VBAで業務を自動化したい かみちゃん 10/3/10(水) 20:44 発言
【64740】Re:VBAで業務を自動化したい 電池切れ 10/3/10(水) 22:19 発言
【64741】Re:VBAで業務を自動化したい かみちゃん 10/3/10(水) 23:02 発言
【64742】Re:VBAで業務を自動化したい 電池切れ 10/3/10(水) 23:12 発言
【64873】VBAで業務を自動化できました(解決) 電池切れ 10/3/23(火) 0:04 お礼

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