| |
なば さん、こんばんわ。
>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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
