edcrfvtbgynhuif







Sub test()

  For a1 = 3 To 23
       For a2 = 3 To 13
       
           If Cells(a1, a2).Interior.ColorIndex = 37 And _
              Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 37 Then '37のセルの下が37じゃなかったら
              
               If Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 1 Or _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 34 Then
                   b2 = Cells(a1, a2).End(xlDown).Offset(-1, 0).Row
                   Cells(a1, a2).Cut Cells(b2, a2)
               End If
               
               If (Cells(b2, a2).Offset(1, 0).Interior.ColorIndex = 34 Or _
                   Cells(b2, a2).Offset(1, 0).Interior.ColorIndex = 1) And _
                   Cells(b2, a2).Interior.ColorIndex = 37 Then
                   Cells(b2, a2).Interior.ColorIndex = 34
               End If
               
           ElseIf Cells(a1, a2).Interior.ColorIndex = 37 And _
              Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 37 Then
               b1 = Cells(a1, a2).End(xlDown).Row
               b3 = Cells(a1, a2).End(xlDown).End(xlDown).Offset(-1, 0).Row
               If Cells(b1, a2).Offset(1, 0).Interior.ColorIndex <> 1 And _
                  Cells(b1, a2).Offset(1, 0).Interior.ColorIndex <> 34 Then
                   a3 = a1
                   Do
                       Range(Cells(a3, a2), Cells(b1, a2)).Cut Cells(a3, a2).Offset(0, 1)
                       b4 = Cells(a3, a2).Offset(0, 1).End(xlDown).Row
                       If Cells(a3, a2).Offset(0, 1).Interior.ColorIndex = 37 Then
                            Cells(a3, a2).Offset(0, 1).Cut Cells(a3, a2).Offset(1, 1)
                       Else
                           b5 = Cells(a3, a2).Offset(0, 1).End(xlDown).End(xlDown).Row
                      a3 = a3 + 1
                   Loop While (a3 = b3 - (b1 - a3))
                   Range(Cells(b3 - (b1 - a1), a2), Cells(b3, a2)).Interior.ColorIndex = 34
               End If
           ElseIf Cells(a1, a2).Interior.ColorIndex = 37 And _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 0 And _
                  Cells(a1, a2).Offset(0, -1).Interior.ColorIndex = 37 Then
                   Cells(a1, a2).Offset(0, -1).Interior.ColorIndex = 34
                   Cells(a1, a2).Interior.ColorIndex = 34
           
           ElseIf Cells(a1, a2).Interior.ColorIndex = 37 And _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 0 And _
                  Cells(a1, a2).Offset(0, 1).Interior.ColorIndex = 37 Then
                   Cells(a1, a2).Interior.ColorIndex = 34
           
           End If
       Next a2
   Next a1

End Sub

Sub test2()

  For a1 = 3 To 23
       For a2 = 3 To 13
       
           If Cells(a1, a2).Interior.ColorIndex = 37 And _
              Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 37 Then '37のセルの下が37じゃなかったら
              
               If Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 1 Or _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 34 Then '1つ下にカットペ
' b2 = Cells(a1, a2).End(xlDown).Offset(-1, 0).Row
                  Cells(a1, a2).Cut Cells(a1, a2).Offset(1, 0)
               End If
               

          
           End If
       Next a2
   Next a1
   
   For a1 = 3 To 23
       For a2 = 3 To 13
       
           If Cells(a1, a2).Interior.ColorIndex = 37 And _
              Cells(a1, a2).Offset(1, 0).Interior.ColorIndex <> 37 Then '37のセルの下が37じゃなかったら
               
               If ((Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 34 Or _
                   Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 1) And _
                   Cells(a1, a2).Interior.ColorIndex = 37) Then 'もしカットペしたやつの1つ下が地面だったら
                   Cells(a1, a2).Interior.ColorIndex = 34
               End If

              If (Cells(a1, a2).Offset(-1, 0).Interior.ColorIndex = 34 Or _
                   Cells(a1, a2).Offset(0, 1).Interior.ColorIndex = 34 Or _
                   Cells(a1, a2).Offset(0, -1).Interior.ColorIndex = 34) Then
                                                                             'もしカットペしたやつのまわりが地面だったら
                   Cells(a1, a2).Interior.ColorIndex = 34
               End If
           
           End If
       Next a2
   Next a1
   

              
   For a1 = 3 To 23
       For a2 = 3 To 13
               
           If Cells(a1, a2).Interior.ColorIndex = 37 And _
              Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 37 Then
               b1 = Cells(a1, a2).End(xlDown).Row
               b3 = Cells(a1, a2).End(xlDown).End(xlDown).Offset(-1, 0).Row
               If Cells(b1, a2).Offset(1, 0).Interior.ColorIndex <> 1 And _
                  Cells(b1, a2).Offset(1, 0).Interior.ColorIndex <> 34 Then
                   a3 = a1
                   Do
                       Range(Cells(a3, a2), Cells(b1, a2)).Cut Cells(a3, a2).Offset(0, 1)
                       b4 = Cells(a3, a2).Offset(0, 1).End(xlDown).Row
                       If Cells(a3, a2).Offset(0, 1).Interior.ColorIndex = 37 Then
                            Cells(a3, a2).Offset(0, 1).Cut Cells(a3, a2).Offset(1, 1)
                       Else
                           b5 = Cells(a3, a2).Offset(0, 1).End(xlDown).End(xlDown).Row
                      a3 = a3 + 1
                   Loop While (a3 = b3 - (b1 - a3))
                   Range(Cells(b3 - (b1 - a1), a2), Cells(b3, a2)).Interior.ColorIndex = 34
               End If
           ElseIf Cells(a1, a2).Interior.ColorIndex = 37 And _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 0 And _
                  Cells(a1, a2).Offset(0, -1).Interior.ColorIndex = 37 Then
                   Cells(a1, a2).Offset(0, -1).Interior.ColorIndex = 34
                   Cells(a1, a2).Interior.ColorIndex = 34
           
           ElseIf Cells(a1, a2).Interior.ColorIndex = 37 And _
                  Cells(a1, a2).Offset(1, 0).Interior.ColorIndex = 0 And _
                  Cells(a1, a2).Offset(0, 1).Interior.ColorIndex = 37 Then
                   Cells(a1, a2).Interior.ColorIndex = 34
           
           End If
       Next a2
   Next a1
   
   'これらをsubからend subまで全部do_loopでwhile(37の色のセルがなくなるまで)繰り返し

End Sub

Sub t()

  Cells(6, 7).Interior.ColorIndex = 37 '浮いてるやつ

End Sub

Sub e()

  Cells(8, 7).Interior.ColorIndex = 34

End Sub

  • 最終更新:2018-01-23 12:49:59

このWIKIを編集するにはパスワード入力が必要です

認証パスワード