人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

こんにちは。

CSV形式のファイルをExcel2003で読み込みます。
この、読み込んだファイルの全行をソートして、重複した行を一つに纏めたいのですが
どのようにすればいいのでしょうか?

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


●質問者: inu
●カテゴリ:コンピュータ
✍キーワード:CSV こんにちは ソート ファイル
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Jane_Style
●27ポイント ベストアンサー

同様の質問がありましたのでどうぞ

http://q.hatena.ne.jp/1147441463

削除が目的であればフィルタをかけるよりifで重複行を見つけて削除するほうがいいですね

また、フィルタをかけてそのフィルタした表で表示されている部分をコピーして別のファイルに抜き出すのも一つの手だと思います


2 ● chyopper
●27ポイント

こちらが分かりやすいです。

http://www.wanichan.com/pc/excel/2003/05/191.html

何度も実行する場合はマクロを組んだほうがいいと思いますが。


3 ● SALINGER
●26ポイント

Excelに既にCSVが読み込まれているとして、ソートして重複行を削除するマクロです。

Sub Macro1()
 Dim lastRow As Long
 Dim lastColumn As Long
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim f1 As Boolean
 Dim f2 As Boolean
 
 Application.ScreenUpdating = False
 
 lastRow = ActiveSheet.UsedRange.Rows.Count
 lastColumn = ActiveSheet.UsedRange.Columns.Count
 
 ActiveSheet.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
 xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
 SortMethod:=xlPinYin, DataOption1:=xlSortNormal
 
 For i = lastRow To 2 Step -1
 f2 = False
 For j = i - 1 To 1 Step -1
 f1 = False
 For k = 1 To lastColumn
 If Cells(i, k).Value <> Cells(j, k).Value Then
 f1 = True
 Exit For
 End If
 Next k
 If Not f1 Then
 f2 = True
 Exit For
 End If
 Next j
 If f2 Then
 Rows(i).Delete
 End If
 Next i
 
 Application.ScreenUpdating = True
End Sub

いっそのこと、最初から重複をチェックしながらCSVを読み込むマクロもできます。

最初の方をCSVのパスに変更して実行してみてください。

ここでは冗長になるのでソートはしていません。

Sub Macro2()
  '実際のCSVのパスに変更
 Const CSVPath = "C:\Documents and Settings\hogehoge\デスクトップ\test.csv"
 Dim FSO
 Dim TS
 Dim s As Variant
 Dim h As Variant
 Dim r As Long
 Dim f1 As Boolean
 Dim f2 As Boolean
 Dim i As Long
 Dim j As Long
 
 Application.ScreenUpdating = False
 r = 1
 
 Set FSO = CreateObject("Scripting.FileSystemObject")

 TS = FSO.OpenTextFile(CSVPath).ReadAll()
 For Each s In Split(TS, vbNewLine)
 h = Split(s, ",")
 f2 = False
 If r > 1 Then
 For j = 1 To r
 f1 = False
 For i = 1 To UBound(h) + 1
 If Cells(j, i).Value <> h(i - 1) Then
 f1 = True
 Exit For
 End If
 Next i
 If Not f1 Then
 f2 = True
 Exit For
 End If
 Next j
 End If
 If Not f2 Then
 For i = 1 To UBound(h) + 1
 Cells(r, i).Value = h(i - 1)
 Next i
 r = r + 1
 End If
 Next
 
 Set FSO = Nothing
 Application.ScreenUpdating = True
End Sub
関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ