Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

37487 / 76732

←次へ　｜　前へ→


	【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

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

以下のコードだと、表示時１分１２秒、Application.Visible = Falseで１分９秒でした。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