| 
    
     |  | こんにちは。 なんか面白そうだったので。
 正方形セル範囲(縦横同じセル数で、奇数個)にしか対応してません。
 
 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
 
 
 |  |