| |
はじめまして、ＶＢＡ初心者のマスクと申します。
現在、標記の通りの
１、ＣＳＶファイルを読み込む
２、日付を入力し、その日付を含む行を抽出
３、別シートの空白列に貼り付けたい
４、また別のＣＳＶファイルを開く
５、日付を入力し、その日付を含む行を抽出（２と同じ日付です）
６、別シートの空白列に貼り付けたい
（３でＡ１〜Ｂ４まで埋まっていたら、次はＣ１から貼り付けたい）
と続く感じのＶＢＡマクロを作りたいと考えています。
色々と試行錯誤したのですが、上手く動かず、こちらに質問させていただきました。
まず、上記をＡＤＯやＦＳＯを使い動かそうとやってみたのですが知識不足で上手く動きませんでした。
あと空白行を取得する事例は見つけることが出来るのですが、空白列を取得しそこに貼り付けるという動きをするような事例を見つけることが出来ず、そこがまったくの手つかずとなっています。
このようなプログラムを作るにはどういった関数を使えば良いかなどヒントでも良いので、教えてください。宜しくお願いします。
＜考えた例＞
Option Explicit
' テキストファイル読み込みサンプル3(FSO)
' 参照設定：Microsoft Scripting Runtime
Sub READ_TextFile3()
' 読み込むファイル名(固定)
Const cnsFILENAME = "C:\TEMP\HOGE.txt"
Dim FSO As New FileSystemObject' FileSystemObject
Dim TS As TextStream ' TextStream
Dim strREC As String ' 読み込んだレコード内容
Dim GYO As Long ' 収容するセルの行
' 指定ファイルをOPEN(入力モード)
Set TS = FSO.OpenTextFile(cnsFILENAME, ForReading)
GYO = 1
' ファイルのEOF(End of File)まで繰り返す
Do Until TS.AtEndOfStream
' 改行までをレコードとして読み込む
strREC = TS.ReadLine
' 行を加算しA列にレコード内容を表示(先頭は2行目)
GYO = GYO + 1
Cells(GYO, 1).Value = strREC
Loop
' 指定ファイルをCLOSE
TS.Close
Set TS = Nothing
Set FSO = Nothing
End Sub
' ファイルのEOF(End of File)まで繰り返す
の所に特定の文字列を検索し、抽出、別シートにコピーするようなコードを入れることが出来れば動くのではないかなーと色々試してみたのですが、上手くいきません。
＜考えた例２＞
Sub Sample()
Dim Cn As Object
Dim Rs As Object
Dim c As Object
Dim SQL As String
Dim Path As String
Dim key As String
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "CSVファイル", "*.csv", 1
.Filters.Add "全ファイル", "*.*", 2
.FilterIndex = 1
.Title = "ファイル選択"
.AllowMultiSelect = False
If .Show Then
Path = .SelectedItems(1)
Else
MsgBox "処理を中止します", 48
Exit Sub
End If
End With
Application.ScreenUpdating = False
On Error Resume Next
On Error GoTo 0
key = Inputbox("日付を入力してください")
Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Choose(1, key)
Set Cn = CreateObject("ADODB.Connection")
Set Rs = CreateObject("ADODB.Recordset")
With CreateObject("Scripting.FileSystemObject")
SQL = "Select * From " & .GetBaseName(Path) & "." & .GetExtensionName(Path) & _
" Where A1 Like '%" & Choose(1, Key) & "%' "
If Val(Application.Version) >= 12 Then
Cn.Provider = "Microsoft.Ace.OLEDB.12.0"
Else
Cn.Provider = "Microsoft.Jet.OLEDB.4.0"
End If
Cn.Properties("Extended Properties") = "Text;Hdr=No"
Cn.Open .GetParentFolderName(Path)
End With
Set Rs = Cn.Execute(SQL)
Range("空白列の一行目から").CopyFromRecordset Rs
Cn.Close
Set Cn = Nothing
Set Rs = Nothing
MsgBox "Finish", 64
End Sub
元のＣＳＶファイルも、まとめる予定の別シートにも項目がないので
ＳＱＬのwhereの所に何を指定すればいいのか、Ａ列でも可能なのか調べても
出てこなくて困っています。
インターネットで類似ソースを見つけ、改造するという手法で今まで簡単なツールは作成してきたので、知識不足だとは思いますが
助言を頂けたら助かります。
宜しくお願いします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
