| |
▼たつ さん：
>6万件以上のCSVデータをエクセルへ出力するようにマクロを組みました
件数が多いようなので、余計な事とは思いつつ、
DAOを使ってみてはいかがかと思い、作ってみました。
'要参照設定「Microsoft DAO X.X Object Library」
Sub test_sample()
Dim myDB As DAO.Database
Dim myRS As DAO.Recordset
Dim mySQL As String
Dim myPath As String
Dim myCsvNM As String
Dim myField() As String
Dim myLoop As Long
myPath = "C:TEST"
myCsvNM = "集計.csv"
Set myDB = DBEngine.Workspaces(0).OpenDatabase(myPath, False, False, "Text;HDR=YES;")
'項目名取得
mySQL = "SELECT * FROM " & myCsvNM
Set myRS = myDB.OpenRecordset(mySQL, dbOpenSnapshot)
For myLoop = 1 To myRS.Fields.Count
ReDim Preserve myField(1 To 1, 1 To myLoop)
myField(1, myLoop) = myRS(myLoop - 1).Name
Next myLoop
Set myRS = Nothing
'出力x3
mySQL = "SELECT * FROM " & myCsvNM & " WHERE [" & myField(1, 2) & "] Like '1*' "
Set myRS = myDB.OpenRecordset(mySQL, dbOpenSnapshot)
With Sheets("1")
.Range(.Cells(1, 1), .Cells(1, UBound(myField, 2))).Value = myField
.Range("A2").CopyFromRecordset myRS
End With
Set myRS = Nothing
mySQL = "SELECT * FROM " & myCsvNM & " WHERE [" & myField(1, 2) & "] Like '2*' "
Set myRS = myDB.OpenRecordset(mySQL, dbOpenSnapshot)
With Sheets("2")
.Range(.Cells(1, 1), .Cells(1, UBound(myField, 2))).Value = myField
.Range("A2").CopyFromRecordset myRS
End With
Set myRS = Nothing
mySQL = "SELECT * FROM " & myCsvNM & " WHERE [" & myField(1, 2) & "] Not Like '1*'" & _
" And [" & myField(1, 2) & "] Not Like '2*' "
Set myRS = myDB.OpenRecordset(mySQL, dbOpenSnapshot)
With Sheets("その他")
.Range(.Cells(1, 1), .Cells(1, UBound(myField, 2))).Value = myField
.Range("A2").CopyFromRecordset myRS
End With
Set myRS = Nothing
Set myDB = Nothing
End Sub
半分、私の"自己満足"なので、不要ならスルーして下さい＾＾；
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
