|
▼kenkyu-sya さん:
アップ済みのコードと基本かわりませんが、処理効率を若干あっぷさせたものも参考までに。
Sub Test2()
Dim r As Range
Dim a As Range
Dim f As Range
Dim t As Range
Application.ScreenUpdating = False
With Range("A1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
For Each r In .Rows
On Error Resume Next
Set a = r.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not a Is Nothing Then
If a.Areas.Count > 1 Then
Set f = a.Areas(1).Cells(1)
Set t = a.Areas(a.Areas.Count).Cells(a.Areas(a.Areas.Count).Cells.Count)
Range(f, t).Value = f.Value
End If
End If
Next
End With
End With
End Sub
|
|