Excel VBA質問箱 IV

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

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


37493 / 76738 ←次へ | 前へ→

【44410】Re:Replace関数の処理速度の変化について
発言  りん  - 06/11/15(水) 17:40 -

引用なし
パスワード
   なば さん、こんばんわ。

>Sub Sample1()
> Dim objFileSys   As Scripting.FileSystemObject
> Dim objFileSrch  As FileSearch
> Dim objExcelAppl  As Excel.Application
> Dim objExcelWBooks As Excel.Workbooks
> Dim objExcelWBook As Excel.Workbook
> Dim objSheet    As Worksheet '処理対象ワークシート
> 
> Set objFileSys = CreateObject("Scripting.FileSystemObject")
> Set objFileSrch = Application.FileSearch
> 
> Set objExcelAppl = CreateObject("Excel.Application")
> Set objExcelWBooks = objExcelAppl.Workbooks

↑ここら辺になにかあるんでしょうかね。


以下のコードだと、表示時1分12秒、Application.Visible = Falseで1分9秒でした。XL2003 & WinXP

Sub Sample1()
 Dim objExcelWBook As Workbook, objSheet As Worksheet, t1 As Double
 t1 = Now
 Application.Visible = False
 Set objExcelWBook = Application.Workbooks.Add
 Set objSheet = objExcelWBook.Worksheets(1)
 '*****サンプルデータ作成*****
 Sample2 objSheet
 'objExcelWBook.Save

 '*****半角カナ→全角カナ変換*****
 Sample3 objSheet
 '
 Application.Visible = True
 MsgBox Format(Now - t1, "hh:mm:ss"), vbInformation, "処理完了です"
End Sub

Sub Sample2(ByRef objSheet As Worksheet)
 objSheet.Range("A1").Value = "12アイウエオ34"
 objSheet.Range("A2").Value = "56カキクケコ78"

 objSheet.Range(objSheet.Range("A1"), objSheet.Range("A2")).Copy
 objSheet.Range(objSheet.Range("A1"), objSheet.Cells(1500, 200)).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
End Sub

Sub Sample3(ByRef objSheet As Worksheet)
 Dim lngCode    As Long 'ループカウンタ
 Dim rngUsdRange  As Range '処理範囲
 Dim strHankaku   As String '半角カナ
 Dim strZenkaku   As String '全角カナ
 Dim r1 As Range
 Set rngUsdRange = objSheet.UsedRange
 '
 Application.ScreenUpdating = False
 '
 For lngCode = 166 To 221
  strHankaku = Chr$(lngCode) '半角カナ
  strZenkaku = StrConv(strHankaku, vbWide)  '全角カナ
  Application.ScreenUpdating = False
  '処理状況をステータスバーに表示
  Application.StatusBar = strZenkaku
  'とりあえず探してみる
  On Error Resume Next
  Set r1 = rngUsdRange.Find(what:=strHankaku, LookAt:=xlPart)
  On Error GoTo 0
  '見つかった場合は変換
  If Not r1 Is Nothing Then
   '半角カナ→全角カナ変換
   rngUsdRange.Replace what:=strHankaku, Replacement:=strZenkaku, MatchCase:=False, Matchbyte:=True
  End If
  Set r1 = Nothing
 Next lngCode
 '
 Application.StatusBar = False
 Application.ScreenUpdating = True
End Sub

0 hits

【44394】Replace関数の処理速度の変化について なば 06/11/14(火) 21:07 質問
【44395】Re:Replace関数の処理速度の変化について なば 06/11/14(火) 21:20 発言
【44406】Re:Replace関数の処理速度の変化について Jaka 06/11/15(水) 10:37 発言
【44409】Re:Replace関数の処理速度の変化について なば 06/11/15(水) 15:50 質問
【44410】Re:Replace関数の処理速度の変化について りん 06/11/15(水) 17:40 発言
【44440】Re:Replace関数の処理速度の変化について なば 06/11/16(木) 12:03 お礼

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