Seek関数を使いこなすには
解決始めまして、UMEBAINDといいます。
VBAは初心者なもので教えていただきたいのですが、
以下のようなプログラムを作りSEEK関数を利用して
ファイルから検索している文字が見つかれば
新たに検索する文字を入れ替え
見つかった行のその次の行から検索し処理を
短時間で終了させるような事をやりたいのですが
＜＜＜このPGの本体とも言うべきプログラムは約２５万件の処理を
行う為＞＞＞
どうかご教授ください。
よろしくお願いします。
プログラム↓
Sub FSEEK()
'MsgBox "引数＝" & Mails
Dim s As String
Dim MyArray
Dim d
s = CurDir 'カレントフォルダを取得する
MyArray = Split(s, "\", -1) 'カレントフォルダを"¥"で分割する
'カレントフォルダを再構成する
s = MyArray(0) & "\" & MyArray(1) & "\" & MyArray(2) & "\" & "デスクトップ\ファイルシーク"
ChDir s 'カレントフォルダを変更する
Dim strFILENAME2 As String
strFILENAME2 = s & "\FILESEEK2.txt"
Dim strREC 'オーバーフローの為
Dim setlist As Variant 'SPLITの戻り値はバリアント型の為
Dim n, comt, counter
'strFILENAME2 = s & "\FILESEEK2.txt"
Dim intFileno As Integer
Dim i
Dim jjj As Variant
Dim uuu As Long
Dim dse, A1, A2 As String
Open strFILENAME2 For Input As #1
Dim strtest
Dim ddd As String
Dim FPos As Long
counter = 0
i = 1
Do Until EOF(1)
Line Input #1, strREC
jjj = Split(strREC, ",")
dse = jjj(1)
A1 = "6columsyori"
A2 = "12columsyori"
If StrComp(dse, A1) = 0 Then
MsgBox i & "行目" & "で見つかりました！" & A1 & "行目の処理：" & Loc(1)
FPos = Seek(1)
MsgBox FPos & "⇔本当の現在位置"
A1 = ""
A1 = A2 '処理の入れ替え
Seek #1, FPos + 1 '見つかった位置から検索する
End If
i = i + 1
Loop
'
Close #intFileno
End Sub
データは以下のファイルです。・＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
\FILESEEK2.txt
1FILESEEKTESTNOW,1columsyori
2FILESEEKTESTNOW,2columsyori
3FILESEEKTESTNOW,3columsyori
4FILESEEKTESTNOW,4columsyori
5FILESEEKTESTNOW,5columsyori
6FILESEEKTESTNOW,6columsyori
5FILESEEKTESTNOW,7columsyori
5FILESEEKTESTNOW,8columsyori
9FILESEEKTESTNOW,9columsyori
10FILESEEKTESTNOW ,10columsyori
11FILESEEKTESTNOWSEEEK ,11columsyori
12FILESEEKTESTNOW ,12columsyori
13FILESEEKTESTNOWSEEEK,13columsyori
14FILESEEKTESTNOW ,14columsyori
15FILESEEKTESTNOW ,15columsyori
16******************** ,16columsyori
17 uu ,17columsyori
18 uuuu ,18columsyori
19FILESEEKTESTNOW,19columsyori
20FILESEEKTESTNOW,20columsyori
21FILESEEKTESTNOW,21columsyori
22FILESEEKTESTNOW,22columsyori
23 g ,23columsyori
24 g ,24columsyori
25 g ,25columsyori
26 g ,26columsyori
27 g ,27columsyori
28 g ,28columsyori
29 g ,29columsyori
30 g ,30columsyori
Line Inputでよみこんでいるんだから次の読み込み位置は
自動的に次の行になっているんじゃないの？
つまりSeekを使う必要がないんじゃないかということです。
いつの間にかVBAの話になっていたのねｗ
前の質問の続きならVB6かと思ってた。
その行に目的の文字列が含まれているかどうかだけ分かればいいのであれば
下記の方法も有りかと。
どっちが速く処理できるかは実際試して見ないと分かりませんが。
If InStr(strRec,A1)>0 Then
以下略
If strRec Like "*" & A1 & "*" Then
もしくは
If strRec Like "*" & A1 Then
以下略
ところで続き物だったんですか？
できれば参考のため前のURLも入れて下さい。
ロジック的に大丈夫なの？
A1 = A2 '処理の入れ替え としているが
少し上のほうで
A1 = "6columsyori"
A2 = "12columsyori"
としているぞ。
Do Untilの前に出さなければ、ずっと"6columsyori"を探していることになるんでないかい？
すみません
A1 = "6columsyori"
A2 = "12columsyori"の定義はDo Untilの前ですね
それと後、A2が見つかればEXIT DOですね。
。。。←さんえ、データがソートされて昇順になっているので
また頭からぐりぐり廻すのではなくて
見つかった行から処理する方が早いと思われるので（２５万件の処理）
>見つかった行から処理する方が早いと思われるので
いや、だから見つかったところから続けてやるのならSeekはいらないと
いうことをいってるんですが。
ファイルを閉じて再度開いてSeekするのなら分かりますが、提示のコード
はそうしてないでしょ？
>>また頭からぐりぐり廻すのではなくて
このレスで、やりたいことがわからなくなった。
Sub FSEEK()
'概要：ファイルシークによる多重ループの高速化
'前提条件: *****、メールアドレスが昇順でソートされている事
'機能:
'******を見つけたファイルポインタをGLOBAL変数に記憶する
'次回処理されたら、前回処理された位置から処理するように
'GLOBAL変数から値を取り出しファイルポインタに設定する
'もし見つからなければファイルポインタを最初に設定し
'検索をやり直す、そして前回処理された場所まで処理する
'MsgBox "引数＝" & Mails
Dim s As String
Dim MyArray
Dim d
s = CurDir 'カレントフォルダを取得する
MyArray = Split(s, "\", -1) 'カレントフォルダを"¥"で分割する
'カレントフォルダを再構成する
s = MyArray(0) & "\" & MyArray(1) & "\" & MyArray(2) & "\" & "デスクトップ\ファイルシーク"
ChDir s 'カレントフォルダを変更する
Dim strFILENAME2 As String
strFILENAME2 = s & "\FILESEEK2.txt"
' Dim strFILENAME3 As String
'Dim setlist(200) As String
' strFILENAME3 = "kihon_dl.csv"
' Dim strREC As String ' 読み込んだレコード内容
Dim strREC 'オーバーフローの為
Dim setlist As Variant 'SPLITの戻り値はバリアント型の為
Dim n, comt, counter
'strFILENAME2 = s & "\FILESEEK2.txt"
Dim intFileno As Integer
Dim i
Dim jjj As Variant
Dim uuu As Long
Dim dse, A1, A2 As String
Open strFILENAME2 For Input As #1
' Close #intFileno
Dim strtest
Dim ddd As String
Dim FPos As Long
counter = 0
i = 1
Dim gcounter
A1 = "6columsyori"
A2 = "7columsyori"
Do Until EOF(1)
Line Input #1, strREC
jjj = Split(strREC, ",")
dse = jjj(1)
If gcounter = 2 Then Exit Do
If StrComp(dse, A1) = 0 Then
gcounter = gcounter + 1
MsgBox i & "行目" & "で見つかりました！" & A1 & "行目の処理：" & Loc(1)
FPos = Seek(1)
MsgBox FPos & "⇔本当の現在位置"
A1 = ""
A1 = A2 '処理の入れ替え
Seek #1, FPos '見つかった位置から検索する
' Seek #1, FPos + 1 '見つかった位置から検索する
End If
i = i + 1
Loop
'
Close #intFileno
End Sub
解決しました、有難う御座います。
今までより少し早くなったようです
３０分→５００件、１０分３５０→件
解決したと書いてますが、これで、本当に解決したんでしょうか？
コードをみると、グローバル変数なんて使ってないし、毎回必ずファイルの
最初から検索してますけど(^^;
それから、A1が見つかったら、その次の行からA2を検索してるけど、
その部分はLine Inputで読んでいけばわざわざSeekする必要もないのでは？
http://www.accessclub.jp/bbs3/wforum.cgi?no=39759&reno=no&oya=39759&mode=msgview&page=0
↑こーゆー指摘も受けてますが…(＾＾；)
> Dim dse, A1, A2 As String
の前２つの変数は[VBA]でも Variant では？とか
全体的に変数とその型についてあやふや…つっこみだすと
きりがないとは思います。…質問が
>Seek関数を使いこなすには
だから『Seekする必要ない』って言われたら終わっちゃうとか？ｗ
本人が満足しているみたいなんで何もいいませんが
>Seek #1, FPos '見つかった位置から検索する
これあってもなくても一緒。
正しくコメントを入れるとこんな感じかな？
FPos = Seek(1) '見つかったら現在の位置を取得
Seek #1, FPos '現在の位置へ移動(意味ねーよ！)
あと少し早くなったのは、A2が見つかったらExit Doしてるからだと
思われる。
Sub foo(ByRef fn As Integer)
'( ´Д｀)＜もっといいのがあるが、ちょと言いたかったので。
Const FindStr1 As String = "6columsyori"
Const FindStr2 As String = "7columsyori"
Dim lineSt As String
Dim status As Long
status = 0
Do While Not EOF(fn)
Line Input #fn, lineSt
Select Case status
Case 0
'find FindStr1
If InStr(1, lineSt, FindStr1) Then
status = 1
Debug.Print FindStr1 & "が見つかりました"
End If
Case 1
'find FindStr2
If InStr(1, lineSt, FindStr1) Then
Debug.Print FindStr2 & "が見つかりました"
Exit Do
End If
End Select
Loop
End Sub
※汚くてスマソ＆終レスに投稿スマソ…(orz
と思ったら誤爆してるな…適当に直してくれ；；
検索する文字列
A1 = "6columsyori"
A2 = "7columsyori"
が、ファイルの中に何個所もあり、呼び出す毎に、見つかった位置から
次のA1・A2を検索するのなら、こんな感じかも。
まぁ、Seek関数を使いこなしてはいないが(^^;
でも、質問者は解決したと思っているのでもう見てないかな？
Private Sub FSEEK()
Dim fso As Object
Dim ts As Object
Dim lngSkipLine As Long
Dim strFileName As String
Dim A(1 To 2) As String
Dim iCounter As Integer
Dim strBuffer As String
Dim dse As String
Static FPos As Long
Const ForReading = 1
Set fso = CreateObject("Scripting.FileSystemObject")
strFileName = "F:\CKJフェイシング表\mast.csv"
Set ts = fso.OpenTextFile(strFileName, ForReading)
'前回見つかった位置から検索する
For lngSkipLine = 1 To FPos
ts.SkipLine
Next lngSkipLine
iCounter = 1
A(1) = "6columsyori"
A(2) = "7columsyori"
Do Until ts.AtEndOfStream
strBuffer = ts.ReadLine
dse = Split(strBuffer, ",")(1)
If StrComp(dse, A(iCounter)) = 0 Then
MsgBox ts.Line & "行目" & "で見つかりました！" & A(iCounter) & "行目の処理"
'見つかった位置を記憶
FPos = ts.Line
'処理の入れ替え
iCounter = iCounter + 1
If iCounter > UBound(A) Then
Exit Do
End If
End If
Loop
ts.Close
Set ts = Nothing
Set fso = Nothing
End Sub
すみません、UMBAINDですこちらの処理のほうが断然早いと解りました
同じ処理でも今までの処理では５時間かかっていたものが（データ１万件）
５分で終了するようになりました
'ハッシュぽい処理
'****************************
'読者番号関連の処理を簡素化し
'ループを１つ破棄し処理全体を
'早める為に行う
'使用されるデータの上限は６万件までとする
'****************************
Dim xlApp2 As Object
Dim strHasyu As String
Dim get_data
Dim set_data As Variant
strHasyu = s & "\jjjjj.txt"
Open strHasyu For Input As #3
'オブジェクトの生成
Set xlApp2 = CreateObject("Scripting.Dictionary")
Do Until EOF(3)
Line Input #3, get_data
'ファイルバッファの分割
set_data = Split(get_data, ",")
'メモリへの展開 'XXXXXXをキーに、XXXXXXをDATAとして格納する
xlApp2.Add set_data(1), set_data(0)
Loop
'ハッシュぽい処理 END**********************
ありがとうございました、マルチポストに対してはそれだけ「必死」
ということで勘弁してください
ファイルシークで処理することなくＶＢＡの辞書機能を
使用することにより２２時間かかる処理が６０分まで短縮しました
Set xlApp2 = CreateObject("Scripting.Dictionary")
そーゆー問題じゃないでしょうが。
なんで、この掲示板って利己主義な質問者ばかりなの？
そうゆう質問者にちゃんとした回答つけちゃうからいなくならない。
| ツイート |  |