CSVデータから重複したデータを一つだけ抜きだして並び替えてエクセルにデータを取り込む

素人です　よろしくお願いします

CSVデータ（AからE、行は複数、A列は数値のみ）からA列の（例　１、４、４，２）重複したデータを一つのみ、且つ、順番どうりに並び替えて、別のワークブックのテンプレートに読みこむ
マクロをおしえてください
何回も異なるデータでその作業をしないといけないので自動で読み込むようにしたいです

質問が多くてすいません　よろしくおねがいします

質問者からの補足コメント

• このようなCSVデータがありまして
  このA列の　重複した番号は上位のデータのみのこして　1、２，３の順番に整列させて
  
  右画像のような別のワークブックに自動で読み込むという作業です

    補足日時：2017/12/09 13:48

• CSVデータ

  
    補足日時：2017/12/09 13:50

• XLS　サンプル
  GGGは１，２，３，４・・・番号
  HHH、EEE、MMM、NNNにB列～E列がはいるように

  
    補足日時：2017/12/09 13:54

• 回答ありがとうございます
  
  作業の流れはよく理解できましたが
  それをVBAでやりたいのです
  何回も作業しなければならず　自動化が必須でして
  
  
  
  その場合のマクロはどのようになるのでしょうか？
  コードを書いていただけますでしょうか？
  
  
  CSVの作業はマクロの記録はできないですよね？
  
  すみません　なにぶん素人でして

  No.2の回答に寄せられた補足コメントです。 補足日時：2017/12/09 14:40

• もうひとつ質問いいよろしいでしょうか？
  
  書かれたマクロでやってみたんですが
  
  実行時エラー’9’：
  書かれた範囲にインデックスが存在しません
  
  というエラーがでました
  
  便宜上？CSVデータはべつのワークブックでひらいているんですね。
  
  そうすると
  With Worksheets("Sheet1")　の部分は
  書き換えないとといけないんですよね？
  
  質問多くてほんとすいません

  No.4の回答に寄せられた補足コメントです。 補足日時：2017/12/11 08:53

• すいません　
  
  コピぺではなくCSVのデータを自動で取り込みたいんですが
  方法はありますか？
  
  
  
  あとから付け足しみたいな感じになってすいません

  No.5の回答に寄せられた補足コメントです。 補足日時：2017/12/11 14:57

• 並び替えできました！
  
  ｗBClose　の後に　マクロの記録ででたマクロを貼り付けたら
  できました！　
  
  他にも問題がでてきたんですが
  （同じワークブックにテンプレートが２つあってCSVでーたを
  ふりわけないといけない（なにかバッティングしてるみたいで　ひらかない））
  というようなことがあるんですが・・・
  
  とにかく教えていただいた事を元にやってみます

  No.6の回答に寄せられた補足コメントです。 補足日時：2017/12/12 15:15

No.7 ベストアンサー 回答者： tom04 回答日時： 2017/12/12 18:26

＞（同じワークブックにテンプレートが２つあってCSVでーたを

＞ふりわけないといけない（なにかバッティングしてるみたいで　ひらかない））

テンプレートが二つあるというのは同じような雛形で別シートが存在する！という意味なのでしょうか？

お手元のファイルがどのようになっているのかこちらでは判らないので
何とも回答のしようがないのですが・・・

とりあえず今回は並び替えのコードを追加したものを投稿しておきます。

Sub Sample3()
Dim myDic As Object
Dim myR, myKey, myItem, myAry
Dim i As Long, lastRow As Long, wS As Worksheet
Dim wB As Workbook, myPath As String, fN As String '//←追加//

'▼CSVファイルを開き、This Workbook のSheet1にコピー&ペースト →　CSVファイルを閉じる//
myPath = "保存場所のパス" & "\"
fN = "ファイル名.csv"
Workbooks.Open Filename:=myPath & fN
Set wB = ActiveWorkbook
wB.Worksheets(1).Cells.Copy ThisWorkbook.Worksheets("Sheet1").Range("A1")
wB.Close
'▲ここまで//

'▼これ以降は前回のコード！//
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 5 Then
Range(wS.Cells(6, "A"), wS.Cells(lastRow, "Q")).ClearContents
End If
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(1, "A"), .Cells(lastRow, "E"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 4) & "_" & myR(i, 5)
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
myR = Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q"))
For i = 0 To UBound(myKey)
myAry = Split(myItem(i), "_")
myR(i + 1, 1) = myKey(i)
myR(i + 1, 4) = myAry(0)
myR(i + 1, 10) = myAry(1)
myR(i + 1, 14) = myAry(2)
myR(i + 1, 17) = myAry(3)
Next i
Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q")) = myR
Set myDic = Nothing
'▼並び替え//
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS.Cells(5, "A"), wS.Cells(lastRow, "Q")).Sort key1:=wS.Range("A5"), order1:=xlAscending, Header:=xlYes
wS.Activate
MsgBox "完了"
End Sub

※　回答しても追加質問が多く、終わりがないようなので
とりあえず以上のコードで今回の質問の回答は終了にさせてください。m(_ _)m

この回答へのお礼

最期まで質問に答えていただきありがとうございます

やっていくと次々問題がでてきまして、
なんとなく　この値を変えるとこうなるとかそういうのはわかるんですが

とにかく自分でやってみて　どうしてもだめだったら別で質問したいと思います

お忙しい中お手数お掛けしまして感謝します

お礼日時：2017/12/12 20:15

No.6 回答者： tom04 回答日時： 2017/12/11 16:52

＞コピぺではなくCSVのデータを自動で取り込みたいんですが・・・

No.３で記載したように、コード記載のブックのSheet1にCSVファイルを取り込んだ後のコードにしています。
もちろんそのCSVファイルを開くことも可能ですが、
保存場所のパスとファイル名が必要になります。

とりあえず、CSVファイルをSheet1にコピー＆ペーストし、Sheet2に表示するコードです。
↓にしてみてください。
操作したいブックの標準モジュールにしてください。

Sub Sample2()
Dim myDic As Object
Dim myR, myKey, myItem, myAry
Dim i As Long, lastRow As Long, wS As Worksheet
Dim wB As Workbook, myPath As String, fN As String '//←追加//

'▼CSVファイルを開き、This Workbook のSheet1にコピー&ペースト →　CSVファイルを閉じる//
myPath = "保存場所のパス" & "\"
fN = "ファイル名.csv"
Workbooks.Open Filename:=myPath & fN
Set wB = ActiveWorkbook
wB.Worksheets(1).Cells.Copy ThisWorkbook.Worksheets("Sheet1").Range("A1")
wB.Close
'▲ここまで//

'▼これ以降は前回のコード！//
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 5 Then
Range(wS.Cells(6, "A"), wS.Cells(lastRow, "Q")).ClearContents
End If
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(1, "A"), .Cells(lastRow, "E"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 4) & "_" & myR(i, 5)
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
myR = Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q"))
For i = 0 To UBound(myKey)
myAry = Split(myItem(i), "_")
myR(i + 1, 1) = myKey(i)
myR(i + 1, 4) = myAry(0)
myR(i + 1, 10) = myAry(1)
myR(i + 1, 14) = myAry(2)
myR(i + 1, 17) = myAry(3)
Next i
Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q")) = myR
Set myDic = Nothing
wS.Activate
MsgBox "完了"
End Sub

※　コード内の「保存場所のパス」と「ファイル名」の部分は
プロパティで確認し、実際のものに書き換えてください。

※　プロパティを確認し、ファイルの種類で「Excel」になっていない場合は
「プログラム」で「Excel」に変更してください。（Excelで開けなかった場合）

※　コード内に記載しましたが、CSVファイルを閉じた後のコードはまったく変わっていません。
まず、本ブックのSheet1にCSVデータをそのまま取り込んで、Sheet2に表示するようにしていますので
「Sheet1」「Sheet2」の部分は実際のシート名にしておいてください。m(_ _)m

この回答へのお礼

誠にありがとうございます　感謝します

見事に表示できました

あと順番を１～順に　並び替えるようにできたら完璧なんですが

その際のマクロを教えていただきたいのですが

あつかましくてすいません

お礼日時：2017/12/12 14:00

No.5 回答者： tom04 回答日時： 2017/12/11 11:01

No.３・4です。

＞便宜上？CSVデータはべつのワークブックでひらいているんですね。

はい！
CSVファイル開き（指定しない場合はおそらくExcelで立ち上がると思います）
その状態がお示しの画像の上側になっているという前提のコードです。
（画像どおり項目行はなく、データは1行目からある）

＞With Worksheets("Sheet1")　の部分は
＞書き換えないとといけないんですよね？

はい！
「Sheet1」の部分は実際のシート名にする必要があります。
もし、別ブックで開いたのであれば、Sheet全体を一旦コピーし、操作したいシートに貼り付け後マクロを実行してください。
当然「Sheet2」の方も実際のシート名に変更してください。m(_ _)m

No.4 回答者： tom04 回答日時： 2017/12/09 22:25

No.3です。

書き忘れたコトが・・・

画像、A列「3」のデータのC列が「5ｍｍ」と「2ｍｍ」の違いがありますが、
最初に出現した「5ｍｍ」の方だけが表示されます。

それでも良いのでしょうか？m(_ _)m

この回答へのお礼

丁寧な回答ありがとうございます　

重複した項目のD,Eが示せればいいので問題ないです

NO,3で書いていただいたマクロでやってみます

なにか問題があればまた質問してもよろしいでしょうか？

お礼日時：2017/12/11 08:19

No.3 回答者： tom04 回答日時： 2017/12/09 22:22

こんばんは！

横からお邪魔します。CAVのデータは手作業でExcelで開き
Sheet1に上記画像のような配置で存在しているとします。
そして下側の画像がSheet2になっているという前提のコードです。

一般的には1行目は項目行になっていると思いますが、
画像どおりデータは1行目からあるとします。
標準モジュールです。

Sub Sample1()
Dim myDic As Object
Dim myR, myKey, myItem, myAry
Dim i As Long, lastRow As Long, wS As Worksheet

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 5 Then
Range(wS.Cells(6, "A"), wS.Cells(lastRow, "Q")).ClearContents
End If
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(1, "A"), .Cells(lastRow, "E"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), myR(i, 2) & "_" & myR(i, 3) & "_" & myR(i, 4) & "_" & myR(i, 5)
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
myR = Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q"))
For i = 0 To UBound(myKey)
myAry = Split(myItem(i), "_")
myR(i + 1, 1) = myKey(i)
myR(i + 1, 4) = myAry(0)
myR(i + 1, 10) = myAry(1)
myR(i + 1, 14) = myAry(2)
myR(i + 1, 17) = myAry(3)
Next i
Range(wS.Cells(6, "A"), wS.Cells(UBound(myKey) + 6, "Q")) = myR
Set myDic = Nothing
wS.Activate
MsgBox "完了"
End Sub

※　Sheet2の6行目以降のデータを一旦消去するようにしていますので、
5列以外のデータ（画像では「JJ」の列）は消えます。

一発で解決！とはいかないと思いますが、
まずは叩き台として・・・m(_ _)m

No.2 回答者： fakeflake 回答日時： 2017/12/09 14:10

よくわかる画像でした。

以下の操作をマクロ登録すればできるでしょう。

元のcsvファイルで行う操作：
1）全てを選択（Ctrl+A）

2）Excelの機能「重複の削除」で重複データを削除する。重複チェック対象はA列のみとする（以下も参照）
https://dekiru.net/article/15288/

3）重複が削除できたら、もう一度Ctrl+Aで選択

4）Ctrl+Cでコピーし、コピー先のファイルに移動

コピー先で行う操作：
5）コピーしたい位置のセルをクリック

6）形式を選択して貼り付け（Ctrl+Alt+C）を行い、貼り付けの選択肢は「値(V)」を選んでOKをクリック

もしcsvファイルのA列の値に従って並べ替えを行う場合は、3）4）の間で行ってください。

No.1 回答者： fakeflake 回答日時： 2017/12/09 11:14

説明だけではいまいちよくわからないので、ワークシートにデータの例とやりたいことを書いてその画像を貼れませんか？それに、条件が足りない気もします。

・重複しているデータの順番とは？重複してるんだからどっちが先でも一緒なのでは？

・同じデータが3つ以上ある可能性が…

・違う値でそれぞれ重複してる、1,4,4,2,2みたいなパターンもあり得そう、でも一つのみとは？

この回答へのお礼

さっそくの回答ありがとうございます

お礼日時：2017/12/09 13:56