|
よち さん、こんにちわ。
>この処理には、前段階で、2項目目の日時をIFで判別しています。
Sub test()
Dim JJ&, NN&, RR&, A$, wb As Workbook, ws As Worksheet
Application.ScreenUpdating = False '処理を画面に表示しない
'作業用ブックを作成
Set wb = Application.Workbooks.Add
With wb.Worksheets(1)
'Dドライブのルートにtest.csvという名前で保存してあるとして
Open "d:\test.txt" For Input As #1
Do Until EOF(1)
NN& = NN& + 1
Line Input #1, A$ 'とりあえず区切らずに読み込む
.Cells(NN&, 1).Value = A$ '転記用
.Cells(NN&, 2).Value = A$ '区切り用
Loop
Close #1
'B列で区切る:データ→区切り位置→タブやカンマ(略)
.Range(.Cells(1, 2), .Cells(NN&, 2)).TextToColumns Destination:=.Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
For RR& = 1 To NN&
'区切ったものはB列から始まるので、日付は3列目
'日付で抽出(時刻は小数なので切り捨てて分岐)
Select Case Int(.Cells(RR&, 3).Value)
Case DateSerial(2005, 2, 25) To DateSerial(2005, 2, 26)
JJ& = JJ& + 1
'マクロのあるブックの左端のシートに転記(読み込んだままの文字列)
ThisWorkbook.Worksheets(1).Cells(JJ&, 1).Value = .Cells(RR&, 1).Value
End Select
Next
End With
'再カット
If JJ& > 0 Then
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets(1)
.Range(.Cells(1, 1), .Cells(NN&, 1)).TextToColumns Destination:=.Range("A1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
End With
Application.DisplayAlerts = True
End If
'作業用ブックを保存しないで閉じる
wb.Saved = True: wb.Close
Application.ScreenUpdating = True '処理を画面に表示する
Set wb = Nothing
End Sub
直接当該ブックによみこまずに、作業ブックをつくって、処理後破棄するようにしています。
処理を繰返すならば、転記先のシートの値の範囲をクリアしてから読み込むようにして下さい。
|
|