Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

39100 / 76732

←次へ　｜　前へ→


	【42751】Re:重複値を、別ブックに書き出したい

ハチ - 06/9/20(水) 16:05 -


	引用なし

	パスワード

▼Palmer さん：

>1.2.は出来ているのですが、3.4.の段階で
>Workbooks.OpenやOffsetメソッド、Dir関数、
>ExecuteExcel4Macroなど調べながら、詰まってしまった状態です。
>いい方法や、検索すべき方法があればご教授いただけないでしょうか。

「重複をどうやって調べるか」　が判らないところですか？
別の重複項目.xlsに出力するとなると、
保存するPathなど確認が必要ですのでとりあえず、このマクロがあるBookに。
出力される情報は、提示されているものと違いますので
考え方の参考になればと思います。

Option Explicit

Sub Test()
　　Dim myFile As String, myPath As String
　　Dim buf As String
　　Dim Ws As Worksheet
　　Dim i As Long
　　myFile = "Test.csv"
　　myPath = ThisWorkbook.Path
　　Set Ws = ThisWorkbook.Worksheets(1)
　　Ws.Cells.ClearContents
　　Ws.Range("A1:C1").Value = Array("項目", "列番号1", "列番号2")
　　i = 0
　　Open myPath & "\" & myFile For Input As #1
　　　　Do Until EOF(1)
　　　　　　Input #1, buf
　　　　　　i = i + 1
　　　　　　Call Find_Test(Ws, buf, i)
　　　　Loop
　　Close #1
　　Ws.Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlUp
　　Set Ws = Nothing

End Sub

Sub Find_Test(Ws As Worksheet, ByVal buf As String, ByVal i As Long)
　　Dim Fi As Variant

　　Set Fi = Ws.Range("A:A").Find(buf, , xlValues, xlWhole)
　　If Not Fi Is Nothing Then
　　　　Fi.End(xlToRight).Offset(, 1).Value = i
　　Else
　　　　Ws.Range("A65536").End(xlUp).Offset(1).Resize(, 2).Value = Array(buf, i)
　　End If
　　Set Fi = Nothing
End Sub

1 hits

▼

【42748】重複値を、別ブックに書き出したい Palmer 06/9/20(水) 14:49