ここから本文です

excel 2013 重複の削除 を 1000個ほどのファイルに対し、実行する必要があり、vba...

アバター

ID非公開さん

2019/5/1217:28:43

excel 2013 重複の削除 を
1000個ほどのファイルに対し、実行する必要があり、vbaやマクロなどで簡易化する方法を探しています。

現在実行しようとしている動作が
1.「test1.csv」をexcel

2013で開く
2.タブの「データ」を選択
3.「重複の削除」を選択
4.一列目のチェックを外す
(2列目〜5列目に対し重複の削除)
*対象データ約百万行
5.重複の削除が終わったら保存し閉じる
6.「test2.csv」に対し1〜5を実施
7.「test3.csv」に対し1〜5を実施
省略
「test1000.csv」に対し1〜5を実施

vbaやバッチなど、何かしらの方法で
自動で処理を行うことはできないでしょうか

閲覧数:
88
回答数:
3
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

kik********さん

2019/5/1310:04:38

> 1000個ほどのファイルに対し、

一気に処理させるつもりですか??

> *対象データ約百万行

Excel で処理できない行数あったらどうしますか???

> 「重複の削除」を選択

これをしたことによって、どの程度の行数残るのですか????

csv 内部の形式は、どうなってますか???
2,3行でも、提示できないのですか???


疑問/不明部分が多々ありますが、雰囲気、以下でどうなりますか

確認は、

・確認用フォルダを作成します(例えば、D:\Hoge )
・新規ブックを開き、標準モジュールに以下を記述し、
一旦、上記フォルダに保存します(例えば、D:\Hoge\q13207658338.xlsm )
・testData を実行して、csv ファイルを作成します
※ 上記フォルダに 確認用フォルダが作られます D:\Hoge\確認用
csv ファイルは、そのフォルダに
・Samp1 を実行すると、フォルダ選択画面になるので、D:\Hoge\確認用 を選んで
結果フォルダ、D:\Hoge\確認用\処理済み フォルダが作成され、
結果は、同じファイル名で作成されます

D:\Hoge\確認用 / D:\Hoge\確認用\処理済み
同じファイル名のものは、次からの処理はスキップされます

ちなみに、
testData で作成したファイル1つを処理する時間は、160秒前後
他の方のは、7分強
デバッグのし難い VBS で有る必要はないように思いますが・・・・

☆ 部分は、バフッとした時間測定用(実際には不要)

なお、重複チェックする部分
1つ目の , の次の文字から全部を対象にしてますが、
1つ目のデータが、" " で囲まれていて、中に , 有る場合がある・・・等々、
もしあれば、それ用の処理に変更してください

あと、細かいチェックは入れていないので・・・
違うフォルダを指定してしまった・・・・とか、
csv の中身が違うものが紛れていた・・・とかとか


どうなりますか


Option Explicit

Public Sub Samp1()
   Dim dic As Object, dicF As Object
   Dim sPath As String, sFile As String, sS As String, s As String
   Dim ffn0 As Integer, ffn1 As Integer
   Dim vK As Variant, v As Variant
   Dim i As Long, k As Long, n As Long
   Const CPE As String = "処理済み\" ' 処理結果フォルダ

   ' 処理対象フォルダを指定してもらう
   With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = ThisWorkbook.Path & "\"
      If (Not .Show) Then Exit Sub
      sPath = .SelectedItems(1) & "\"
   End With
   Dim st As Single ' ☆
   st = Timer() ' ☆

   ' 処理結果を格納するフォルダを、上記フォルダの下に作成
   On Error Resume Next
   MkDir sPath & CPE
   On Error GoTo 0

   Set dic = CreateObject("Scripting.Dictionary")
   Set dicF = CreateObject("Scripting.Dictionary")

   ' 対象フォルダ内の csv ファイル名入手
   sFile = Dir(sPath & "*.csv")
   While (sFile <> "")
      dicF(sFile) = sPath & sFile
      sFile = Dir()
   Wend

   ' 処理結果フォルダに同じ名前があれば、処理対象外に
   sPath = sPath & CPE
   sFile = Dir(sPath & "*.csv")
   While (sFile <> "")
      If (dicF.Exists(sFile)) Then dicF.Remove sFile
      sFile = Dir()
   Wend

   ' 処理するファイルがあったら
   If (dicF.Count > 0) Then
      For Each vK In dicF.Keys
         ffn1 = FreeFile()
         Open dicF(vK) For Input As #ffn1
         ffn0 = FreeFile()
         Open sPath & vK For Output As #ffn0
         dic.RemoveAll
         While (Not EOF(ffn1))
            Line Input #ffn1, sS
            ' 1つ目 , 以降で重複チェックし、なかったら書き出す
            s = Mid(sS, InStr(sS, ",") + 1)
            If (Not dic.Exists(s)) Then
               Print #ffn0, sS
               dic(s) = Empty
            End If
         Wend
         Close
         DoEvents
      Next
   End If

   Set dic = Nothing
   Set dicF = Nothing
   MsgBox Timer() - st ' ☆
End Sub



' 確認用データ作成

Public Sub testData()
   Dim ffn As Integer
   Dim sPath As String, sFile As String
   Dim sA(0 To 25) As String, sS As String, s As String
   Dim i As Long, j As Long, k As Long, n As Long

   Randomize

   sS = InputBox("何ファイル?", , 2)
   If (sS = "") Then Exit Sub
   n = Val(sS)
   If (n < 1) Then n = 1

   For i = 0 To 25
      sA(i) = Chr(Asc("A") + i)
   Next

   sPath = ThisWorkbook.Path & "\確認用\"
   On Error Resume Next
   MkDir sPath
   On Error GoTo 0
   ffn = FreeFile()
   For i = 1 To n
      sFile = "test" & Format(i, "000") & ".csv"
      Open sPath & sFile For Output As #ffn
      Print #ffn, Join(Array("項1", "項2", "項3", "項4", "項5"), ",")
      For k = 1 To 1000000 + (Int(1000 * Rnd()) - 500)
         sS = "行" & k
         For j = 2 To 5
            If (j = 3) Then
               s = Format(Int(1000 * Rnd()), "000")
            Else
               s = sA(Int(26 * Rnd()))
            End If
            sS = sS & "," & s
         Next
         Print #ffn, sS
      Next
      Close #ffn
      DoEvents
   Next
End Sub

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

プロフィール画像

カテゴリマスター

lin********さん

2019/5/1221:58:15

「VBScript」による回答です。

このプログラムは、プログラムファイルの存在するフォルダ内のすべての「csv」ファイルを処理します。

注意事項としては、見つかった「csv」ファイルは、ダブルクリックしてエクセルで開くのと同じなので、すべての列を「標準」で読み込んでいます(頭に「0」がある数字の列は、頭の「0」がきえてしまう)。

すべてのファイルで5列で、1行目が項目名行かどうかは、エクセルに判断させています。

もし、1行目が必ず、「項目名」なら、14行目の

sh.Range("A1:E" & r).RemoveDuplicates Array(2, 3, 4, 5), 0

の、最後の「0」(xlGuess)を「1」(xlYes)に、逆に、必ず「データ」なら「2」(xlNo)にしてください。

★★★
また、今は安全のため、別のファイル名(「abc.csv」なら「abc(Result).csv」)で保存していますが、上書き保存されたい場合は、15行目の

bk.SaveAs gf & "\" & n & "(Result).csv", 6

を、

bk.SaveAs gf & "\" & f.Name, 6

に換えてください。

できれば、フォルダを適当に作成し、そこに数個の「csv」ファイルをプログラムファイルといっしょに放り込んで、実験してみて、ちゃんと「削除」が行われているようなら、実際のファイル群で実行してください。
★★★

以下のプログラムを、メモ帳かテキストエディタにコピー&ペーストし、「~.vbs」という名前で保存します。

「~」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず、半角です。

できたプログラムファイル(「~.vbs」ファイル)を、これから処理したい「csv」ファイル群が存在するフォルダ内に放り込んで、ダブルクリック(「シングルクリック」→「Enter」の方が確実)するだけです。

最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

Option Explicit
Dim bk, ex, f, gf, n, r, sh, so
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(so.GetParentFolderName(WScript.ScriptFullName))
Set ex = CreateObject("Excel.Application")
ex.Application.DisplayAlerts = False
ex.Visible = False
For Each f In gf.Files
If LCase(so.GetExtensionName(f.Name)) = "csv" Then
n = so.GetBaseName(f.Name)
Set bk = ex.Workbooks.Open(gf & "\" & f.Name)
Set sh = bk.ActiveSheet
r = sh.Cells(sh.Rows.Count, "A").End(-4162).Row
sh.Range("A1:E" & r).RemoveDuplicates Array(2, 3, 4, 5), 0
bk.SaveAs gf & "\" & n & "(Result).csv", 6
bk.Close
Set sh = Nothing
Set bk = Nothing
End If
Next
ex.Quit
Set ex = Nothing
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

説明が必要でしたら、言ってください。

大まかには、プログラムファイルの存在するフォルダ内のすべてのファイルを1つずつ調べ、拡張子が「csv」なら、エクセルで開いて、列「2,3,4,5」を指定して「重複の削除」を行い、再び「csv」ファイルとして保存する、をフォルダ内のすべてのファイルで繰り返しています。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

a_h********さん

2019/5/1217:52:58

まずは、1~5の処理を完成させて下さい。

それが出来たら
・フォルダにあるファイルをシートに書き出す
・シートにあるファイル名を順に開いて1~5の処理をする
というふうに改良して完成。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる