|
こんにちは。
なんか面白そうだったので。
正方形セル範囲(縦横同じセル数で、奇数個)にしか対応してません。
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub bbbb()
With Range("D3:L11")
.ClearContents
CCt = .Columns.Count
RCt = .Rows.Count
真中 = Int(CCt / 2 + 0.5)
For i = 0 To Int(CCt / 2) Step 1
RW = i * -1
'Set Rag2 = .Cells(真中, 真中).Offset(RW, RW).Resize(RW * -2 + 1, RW * -2 + 1)
With .Cells(真中, 真中).Offset(RW, RW).Resize(RW * -2 + 1, RW * -2 + 1)
'.Select
If Ct = 0 Then
Ct = Ct + 1
.Value = Ct
Sleep 200 '約0.2秒待機
Else
With .Rows(1).Cells.Resize(, .Rows(1).Cells.Count - 1).Offset(, 1)
'.Select
For ii = 1 To .Cells.Count Step 1
Ct = Ct + 1
.Cells(ii) = Ct
Sleep 200 '約0.2秒待機
Next
End With
With .Columns(.Columns.Count).Cells.Resize(.Columns(.Columns.Count).Cells.Count - 1).Offset(1)
'.Select
For ii = 1 To .Cells.Count Step 1
Ct = Ct + 1
.Cells(ii) = Ct
Sleep 200 '約0.2秒待機
Next
End With
With .Rows(.Rows.Count).Cells.Resize(, .Rows(.Rows.Count).Cells.Count - 1)
'.Select
For ii = .Cells.Count To 1 Step -1
Ct = Ct + 1
.Cells(ii) = Ct
Sleep 200 '約0.2秒待機
Next
End With
With .Columns(1).Cells.Resize(.Columns(1).Cells.Count - 1)
'.Select
For ii = .Cells.Count To 1 Step -1
Ct = Ct + 1
.Cells(ii) = Ct
Sleep 200 '約0.2秒待機
Next
End With
End If
End With
Next
End With
End Sub
|
|