| |
▼pi さん：
激しく遅いですがTextStreamの力技で。
ダウンロードしたKEN_ALL.CSVを
このファイルと同じフォルダに入れてください。
少ないデータ量で試してからにしたほうが良いです。
Option Explicit
Sub Test_BUNKATU()
Dim Str As String
Dim buf() As String
Dim Wr() As Variant
Dim Fg As Boolean
Dim myPath As String
Dim CSVFile As String
Dim FSO As Object
Dim R As Range
Dim ws As Worksheet
myPath = ThisWorkbook.Path
CSVFile = "\KEN_ALL.CSV"
Set ws = ThisWorkbook.Worksheets(1)
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each R In Range(ws.Range("A1"), ws.Range("A65536").End(xlUp))
Fg = False
Str = R.Value
With FSO.GetFile(myPath & CSVFile).OpenAsTextStream
Do Until .AtEndOfStream = True
buf = Split(.ReadLine, ",")
buf(6) = Replace(buf(6), """", "")
buf(7) = Replace(buf(7), """", "")
If Str Like buf(6) & buf(7) & "*" = True Then
Fg = True
Exit Do
End If
Loop
.Close
End With
If Fg = True Then
Wr = Array(buf(6), buf(7), Mid(Str, Len(buf(6)) + Len(buf(7)) + 1))
R.Offset(, 1).Resize(, 3) = Wr
End If
Next R
Set ws = Nothing
Set FSO = Nothing
MsgBox "終了"
End Sub
|
|
ハチ
- 06/8/1(火) 19:56 -
