| 
    
     |  | ▼えすたろう さん: 
 こんにちは
 
 アップされたコード、不要なところもありますが、たとえばそのままで
 処理の最初に 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
 
 
 |  |