|
▼えすたろう さん:
こんにちは
アップされたコード、不要なところもありますが、たとえばそのままで
処理の最初に Application.ScreenUpdationg = False
処理の最後に Application.ScreenUpdationg = True
これをいれるだけで(2003までなら)かなり早くなると思います。
ただ、抜本的には、セルへの書き込み、これが結構ばかにならない処理コストです。
できるだけ、セルとのコンタクト回数を減らすため、
・最初にシートの内容を配列に取り込む
・配列内でループさせて処理する
・最後に一挙にシートに書き戻す。
こうすることで、処理時間は大幅に短縮されます。
この形をとるならApplication.ScreenUpdationg の手当ては不要です。
Sub Sample()
Dim myB As Range
Dim v As Variant
Dim i As Long
With Sheets("貼り付け").Range("A1").CurrentRegion
Set myB = Intersect(.Cells, .Cells.Offset(1))
End With
If Not myB Is Nothing Then
v = myB.Value
For i = 1 To UBound(v, 1)
v(i, 3) = Left(v(i, 1), 2)
v(i, 4) = Mid(v(i, 1), 3)
v(i, 5) = Left(v(i, 2), 2)
v(i, 6) = Mid(v(i, 2), 3)
Next
Sheets("貼り付け").Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
End If
Set myB = Nothing
End Sub
|
|