Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5777 / 13646 ツリー ←次へ | 前へ→

【48903】処理の早い検索について 霧島 07/5/15(火) 16:06 質問[未読]
【48904】Re:処理の早い検索について Kein 07/5/15(火) 16:29 回答[未読]
【48906】Re:処理の早い検索について Kein 07/5/15(火) 16:43 発言[未読]
【48910】Re:処理の早い検索について kita 07/5/15(火) 20:46 質問[未読]
【48915】Re:処理の早い検索について 霧島 07/5/15(火) 23:51 お礼[未読]
【48916】Re:処理の早い検索について kita 07/5/16(水) 0:55 質問[未読]
【48919】Re:処理の早い検索について Jaka 07/5/16(水) 9:37 発言[未読]
【48932】Re:処理の早い検索について kita 07/5/16(水) 13:15 発言[未読]
【48933】Re:処理の早い検索について Kein 07/5/16(水) 14:05 回答[未読]
【48934】Re:処理の早い検索について kita 07/5/16(水) 14:36 お礼[未読]

【48903】処理の早い検索について
質問  霧島  - 07/5/15(火) 16:06 -

引用なし
パスワード
   初めて投稿します。
今、サーバのログを検索するマクロを作っているんですが、他にいい方法
がないかと投稿しました。
マクロはサーバにあるテキストファイルのログをWIN32APIのWnetAddで接続して、
OpenTextで開いています。ただ、毎日6000行程あるのでそれをユーザフォーム
で検索オプションみたいなものを作って絞り込もうと思っています。テキスト
ボックスに入力された文字列をFindで検索してそのセルの10列右のセルに1を
立てます。FindNextでそれを行があるまで続けます。検索が終わったら1を
立てたセルの列を参照し、空白のセルを検索して、あれば、セルをActiveにして
EntireRowで検索文字列がなかった行を削除します。それを最後の1があるセル
までFindNextで繰り返し、検索文字列がある行だけを残します。
これじゃなくて、検索文字列を含まない行(Not検索みたいな)を検索して削除
すれば一つの処理で終わるのにと思うのですが、VBAでできるのは私が考えた
処理が限界なのでしょうか?勉強不足で低レベルな質問かもしれませんが、
何かアドバイスがあれば宜しくお願いします。

【48904】Re:処理の早い検索について
回答  Kein  - 07/5/15(火) 16:29 -

引用なし
パスワード
   例えば A列の最終入力行 までを基準として、A:F列 までで "test" の文字を
検索し、無ければ行全体を削除する。ということがしたいなら・・

  Application.ScreenUpdating = False
  With Range("A1", Range("A65536").End(xlUp)).Offset(, 6)
   .Formula = "=MATCH(""test"",$A1:$F1,0)"
   .Copy
   .PasteSpecial xlPasteValues
   .CurrentRegion.Sort Key1:=Columns(7), Order1:=xlAscending, _
   Header:=xlGuess, Orientation:=xlSortColumns
   If WorksheetFunction.Count(.Cells) < .Count Then
     .SpecialCells(2, 16).EntireRow.ClearContents
   End If
   .ClearContents
  End With
  Range("A1").Select
  With Application
   .CutCopyMode = False
   .ScreenUpdating = True
  End With

というコードで、高速な処理ができると思います。

【48906】Re:処理の早い検索について
発言  Kein  - 07/5/15(火) 16:43 -

引用なし
パスワード
   ちなみに、そのファイルを Openステートメント で開いてループで一行ずつ
読み込み、検索文字があるかどうか判定、あれば同時に Openステートメント
で作った新規テキストファイルに書き込んでいく・・最後に読み込んだ元の
ファイルを削除して終わる。というやり方も考えられます。
この方法も比較的、高速な処理が期待できると思います。

【48910】Re:処理の早い検索について
質問  kita  - 07/5/15(火) 20:46 -

引用なし
パスワード
   ▼Kein さん:
検索に興味があるので質問させてください
横から失礼してすみません""test""の部分を
インプットboxを使うにはどう書き込めばいいのですか?
よろしくお願いします。
Sub test()
Dim i As Variant
i = Application.InputBox("検索文字列を入力してください。", Type:=2)


>例えば A列の最終入力行 までを基準として、A:F列 までで "test" の文字を
>検索し、無ければ行全体を削除する。ということがしたいなら・・
>
>  Application.ScreenUpdating = False
>  With Range("A1", Range("A65536").End(xlUp)).Offset(, 6)
>   .Formula = "=MATCH(""test"",$A1:$F1,0)"
>   .Copy
>   .PasteSpecial xlPasteValues
>   .CurrentRegion.Sort Key1:=Columns(7), Order1:=xlAscending, _
>   Header:=xlGuess, Orientation:=xlSortColumns
>   If WorksheetFunction.Count(.Cells) < .Count Then
>     .SpecialCells(2, 16).EntireRow.ClearContents
>   End If
>   .ClearContents
>  End With
>  Range("A1").Select
>  With Application
>   .CutCopyMode = False
>   .ScreenUpdating = True
>  End With
>
>というコードで、高速な処理ができると思います。

【48915】Re:処理の早い検索について
お礼  霧島  - 07/5/15(火) 23:51 -

引用なし
パスワード
   ▼Kein さん:
 サンプルコードの提供ありがとうございます!!
 見てみましたけど、一部分からないコードがあるので、
 上手くいくか明日職場で作りつつ調べてみます。
 貴重な時間を割いての回答、ありがとうございました。

【48916】Re:処理の早い検索について
質問  kita  - 07/5/16(水) 0:55 -

引用なし
パスワード
   ▼Kein さん:
検索に興味があるので質問させてください
横から失礼してすみません""test""の部分を
インプットboxを使うにはどう書き込めばいいのですか?
よろしくお願いします。

Sub test()
Dim i As Variant
i = Application.InputBox("検索文字列を入力してください。", Type:=2)

★後で読み返して説明が下手でした
Application.InputBoxを利用するには下記コードの修正
方法を教えていただきたいのですが・・・

>例えば A列の最終入力行 までを基準として、A:F列 までで "test" の文字を
>検索し、無ければ行全体を削除する。ということがしたいなら・・
>
>  Application.ScreenUpdating = False
>  With Range("A1", Range("A65536").End(xlUp)).Offset(, 6)
>   .Formula = "=MATCH(""test"",$A1:$F1,0)"
>   .Copy
>   .PasteSpecial xlPasteValues
>   .CurrentRegion.Sort Key1:=Columns(7), Order1:=xlAscending, _
>   Header:=xlGuess, Orientation:=xlSortColumns
>   If WorksheetFunction.Count(.Cells) < .Count Then
>     .SpecialCells(2, 16).EntireRow.ClearContents
>   End If
>   .ClearContents
>  End With
>  Range("A1").Select
>  With Application
>   .CutCopyMode = False
>   .ScreenUpdating = True
>  End With
>
>というコードで、高速な処理ができると思います。

【48919】Re:処理の早い検索について
発言  Jaka  - 07/5/16(水) 9:37 -

引用なし
パスワード
   エラー処理は自分で考えてください。

>i = Application.InputBox("検索文字列を入力してください。", Type:=2)


>>   .Formula = "=MATCH(""test"",$A1:$F1,0)"
          "=MATCH(""" & i & """,$A1:$F1,0)"

【48932】Re:処理の早い検索について
発言  kita  - 07/5/16(水) 13:15 -

引用なし
パスワード
   ▼Jaka さん:
ありがとうございます。
>エラー処理は自分で考えてください。
>
>>i = Application.InputBox("検索文字列を入力してください。", Type:=2)
> ・
> ・
>>>   .Formula = "=MATCH(""test"",$A1:$F1,0)"
>          "=MATCH(""" & i & """,$A1:$F1,0)"
""" & i & """で実行してみたのですが
全部消えます。検索文字は"test"で実行

【48933】Re:処理の早い検索について
回答  Kein  - 07/5/16(水) 14:05 -

引用なし
パスワード
   jakaさん、フォローをどうも。
コード全体を見直して、こんなふうにしてみました。
整数でも文字でも検索できます。検索範囲は前にUPしたコードと同じです。
また、並べ替えのとき、行番号の順番になるように数式を修正しています。

Sub Del_GetRow()
  Dim MyV As Variant
  Const Pmt As String = _
  "文字または整数で検索値を入力して下さい"
 
  With Application
   MyV = .InputBox(Pmt, Type:=3)
   If VarType(MyV) = 11 Then Exit Sub
   .ScreenUpdating = False
  End With
  With Range("A1", Range("A65536").End(xlUp)).Offset(, 6)
   Select Case VarType(MyV)
     Case 2, 3, 5, 6
      .Formula = "=IF(ISNA(MATCH(" & CLng(MyV) & _
      ",$A1:$F1,0)),""a"",ROW())"
     Case 8
      .Formula = "=IF(ISNA(MATCH(" & """" & MyV & """" & _
      ",$A1:$F1,0)),""a"",ROW())"
     Case Else
      MsgBox VarType(MyV) & vbLf & _
      "文字、整数以外の検索はできません", 48: GoTo ELine
   End Select
   .Copy
   .PasteSpecial xlPasteValues
   .CurrentRegion.Sort Key1:=Columns(7), Order1:=xlAscending, _
   Header:=xlGuess, Orientation:=xlSortColumns
   If WorksheetFunction.Count(.Cells) < .Count Then
     .SpecialCells(2, 2).EntireRow.ClearContents
   End If
   .ClearContents
  End With
ELine:
  Range("A1").Select
  With Application
   .CutCopyMode = False
   .ScreenUpdating = True
  End With
End Sub

【48934】Re:処理の早い検索について
お礼  kita  - 07/5/16(水) 14:36 -

引用なし
パスワード
   ▼Kein さん:
横から失礼いたしまして
どうもありがとうございました。
うまくできました。

5777 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free