Ради спортивного интереса , кто нибудь сможет , или вообще возможно ли что то красивей наколякать
Код |
---|
Sub Кнопка1_Щелчок() k1 = 0 k2 = 0 k3 = 0 k4 = 0 For i = 2 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row Step 1 z1 = Cells(i, 1).Value z2 = Cells(i + 1, 1).Value z3 = Cells(i + 2, 1).Value z4 = Cells(i + 3, 1).Value k1 = Cells(i, 5).Value k2 = Cells(i + 1, 5).Value k3 = Cells(i + 2, 5).Value k4 = Cells(i + 3, 5).Value If z1 = z2 And z1 = z3 And z1 = z4 And k4 = 4 Then '----------------------------- 1-2-3-4 Cells(i, 6).Value = Cells(i, 2).Value Cells(i, 7).Value = Cells(i, 3).Value Cells(i, 8).Value = Cells(i, 4).Value Cells(i, 9).Value = Cells(i + 1, 2).Value Cells(i, 10).Value = Cells(i + 1, 3).Value Cells(i, 11).Value = Cells(i + 1, 4).Value Cells(i, 12).Value = Cells(i + 2, 2).Value Cells(i, 13).Value = Cells(i + 2, 3).Value Cells(i, 14).Value = Cells(i + 2, 4).Value Cells(i, 15).Value = Cells(i + 3, 2).Value Cells(i, 16).Value = Cells(i + 3, 3).Value Cells(i, 17).Value = Cells(i + 3, 4).Value i = i + 3 End If '---------------------------------------------------------------------------------- If z1 = z2 And z1 = z3 And Not (z1 = z4) And k1 = 1 And k2 = 2 And k3 = 3 Then '-----1-2-3 Cells(i, 6).Value = Cells(i, 2).Value Cells(i, 7).Value = Cells(i, 3).Value Cells(i, 8).Value = Cells(i, 4).Value Cells(i, 9).Value = Cells(i + 1, 2).Value Cells(i, 10).Value = Cells(i + 1, 3).Value Cells(i, 11).Value = Cells(i + 1, 4).Value Cells(i, 12).Value = Cells(i + 2, 2).Value Cells(i, 13).Value = Cells(i + 2, 3).Value Cells(i, 14).Value = Cells(i + 2, 4).Value i = i + 2 End If '--------------------------------------------------------------------------------- If z1 = z2 And z1 = z3 And Not (z1 = z4) And k1 = 2 And k2 = 3 And k3 = 4 Then '--- 2-3-4 Cells(i, 9).Value = Cells(i, 2).Value Cells(i, 10).Value = Cells(i, 3).Value Cells(i, 11).Value = Cells(i, 4).Value Cells(i, 12).Value = Cells(i + 1, 2).Value Cells(i, 13).Value = Cells(i + 1, 3).Value Cells(i, 14).Value = Cells(i + 1, 4).Value Cells(i, 15).Value = Cells(i + 2, 2).Value Cells(i, 16).Value = Cells(i + 2, 3).Value Cells(i, 17).Value = Cells(i + 2, 4).Value i = i + 2 End If '------------------------------------------------------------------------------- If z1 = z2 And Not (z1 = z3) And Not (z1 = z4) And k1 = 1 And k2 = 2 Then ' ------- 1-2 Cells(i, 6).Value = Cells(i, 2).Value Cells(i, 7).Value = Cells(i, 3).Value Cells(i, 8).Value = Cells(i, 4).Value Cells(i, 9).Value = Cells(i + 1, 2).Value Cells(i, 10).Value = Cells(i + 1, 3).Value Cells(i, 11).Value = Cells(i + 1, 4).Value i = i + 1 End If '------------------------------------------------------------------------------- If z1 = z2 And Not (z1 = z3) And Not (z1 = z4) And k1 = 2 And k2 = 3 Then ' ------- 2-3 Cells(i, 9).Value = Cells(i, 2).Value Cells(i, 10).Value = Cells(i, 3).Value Cells(i, 11).Value = Cells(i, 4).Value Cells(i, 12).Value = Cells(i + 1, 2).Value Cells(i, 13).Value = Cells(i + 1, 3).Value Cells(i, 14).Value = Cells(i + 1, 4).Value i = i + 1 End If '------------------------------------------------------------------------------- If z1 = z2 And Not (z1 = z3) And Not (z1 = z4) And k1 = 3 And k2 = 4 Then ' ------ 3-4 Cells(i, 12).Value = Cells(i, 2).Value Cells(i, 13).Value = Cells(i, 3).Value Cells(i, 14).Value = Cells(i, 4).Value Cells(i, 15).Value = Cells(i + 1, 2).Value Cells(i, 16).Value = Cells(i + 1, 3).Value Cells(i, 17).Value = Cells(i + 1, 4).Value i = i + 1 End If '------------------------------------------------------------------------------ If Not (z1 = z2) And Not (z1 = z3) And Not (z1 = z4) And k1 = 1 Then ' ------------- 1 Cells(i, 6).Value = Cells(i, 2).Value Cells(i, 7).Value = Cells(i, 3).Value Cells(i, 8).Value = Cells(i, 4).Value End If If Not (z1 = z2) And Not (z1 = z3) And Not (z1 = z4) And k1 = 2 Then '-------------- 2 Cells(i, 9).Value = Cells(i, 2).Value Cells(i, 10).Value = Cells(i, 3).Value Cells(i, 11).Value = Cells(i, 4).Value End If If Not (z1 = z2) And Not (z1 = z3) And Not (z1 = z4) And k1 = 3 Then '------------- 3 Cells(i, 12).Value = Cells(i, 2).Value Cells(i, 13).Value = Cells(i, 3).Value Cells(i, 14).Value = Cells(i, 4).Value End If If Not (z1 = z2) And Not (z1 = z3) And Not (z1 = z4) And k1 = 4 Then '-------------- 4 Cells(i, 15).Value = Cells(i, 2).Value Cells(i, 16).Value = Cells(i, 3).Value Cells(i, 17).Value = Cells(i, 4).Value End If z1 = 0 z2 = 0 z3 = 0 z4 = 0 k1 = 0 k2 = 0 k3 = 0 k4 = 0 Next i End Sub |