Антон Федорян

Sub Hexagone(Row As Integer, Col As Integer, Size As Integer)
    Range(Cells(Row, Col), Cells(Row + 2, Col + 1)).Select
    With Selection
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    
    Cells(Row, Col).Select
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row, Col + 1).Select
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 1, Col + 1).Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 2, Col + 1).Select
    With Selection.Borders(xlDiagonalUp)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 2, Col).Select
    With Selection.Borders(xlDiagonalDown)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    Cells(Row + 1, Col).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    
    If ((Row + 3) < (4 * Size - 1)) Then
        Cells(Row + 3, Col).Select
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    End If
End Sub

Sub Grid()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim Size As Integer
    Dim Xn As Integer, Yn As Integer
    
    Set WB = Excel.ActiveWorkbook
    Set WS = WB.Worksheets("Ëèñò1")
    WS.Activate
    
    Size = 15
    
    Range(Cells(1, 1), Cells(4 * Size - 1, 2 * Size)).Select
    Selection.Clear
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Yn = 1
    For y = 1 To Size
        Xn = 1
        For x = 1 To Size
            Call Hexagone(Yn, Xn, Size)
            Xn = Xn + 2
        Next x
        Yn = Yn + 4
    Next y
    
    Randomize
    For Picture = 1 To 20
        x = Int(Size * Rnd) + 1
        y = Int(Size * Rnd) + 1
        If (y Mod 2 = 0) Then
            x = x + 1
        End If
        Cells(3 * y - 1, 2 * x - 1).Select
        ActiveSheet.Pictures.Insert( _
        "C:\Program Files (x86)\Microsoft Office\MEDIA\OFFICE14\AutoShap\BD18253_.wmf") _
        .Select
        Selection.ShapeRange.ScaleWidth 0.3016920425, msoFalse, msoScaleFromTopLeft
    Next Picture
End Sub

result = [0] * 13
initial_value = 1
b = 2.7
divider = b - 1
round_value = 3

for i in range(13):
	if result:
		initial_value += result[i - 1]
	result[i] = round(initial_value / divider, round_value)

for i in range(13):
	print('c{0:d} = {1:.3f}'.format(i, result[i]))

Sub order()
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim objRegExp As New RegExp
    Dim pattern As String
    Dim Dict As New Dictionary
    Dim ResRow As Integer
    Dim NumOrder As Integer
    
    
    Set WB = Excel.ActiveWorkbook
    Set WS = WB.ActiveSheet
    
    ' Ищем только цифры
    pattern = "\d+"
    
    With objRegExp
        .Global = True
        .IgnoreCase = True
        .pattern = pattern
        .MultiLine = True
    End With
    
    ' Номер строки, с которой начинается запись результатов
    ResRow = 10
    ' Проходим со 2 по 5 строки с заказами
    For r = 2 To 5
        ' 2 - столбец с номерами заказов
        Set objMatches = objRegExp.Execute(WS.Cells(r, 2))
        For i = 0 To objMatches.Count - 1
            Set objMatch = objMatches.Item(i)
            NumOrder = objMatch.Value
            
            ' Если номер заказа раньше не встречался
            If Not Dict.Exists(NumOrder) Then
                Dict.Add NumOrder, ResRow
                ' Пишем в 1 столбец номер заказа
                WS.Cells(ResRow, 1) = NumOrder
                ResRow = ResRow + 1
            End If
            
            ' Выписываем номера покупателей
            If IsEmpty(WS.Cells(Dict.Item(NumOrder), 2)) Then
                WS.Cells(Dict.Item(NumOrder), 2) = WS.Cells(r, 1)
            Else
                WS.Cells(Dict.Item(NumOrder), 2) = WS.Cells(Dict.Item(NumOrder), 2) & ", " & WS.Cells(r, 1)
            End If
        Next i
    Next r
    
    Set objRegExp = Nothing
End Sub

=ЕСЛИ(ЕСЛИОШИБКА(ПОИСКПОЗ(A3;$D$3:$D$7;0);0)>0;A3;"Не дублируется")

=ЕСЛИ(ЕСЛИОШИБКА(ПОИСКПОЗ(A3;$D$1:$D$7;0);0)>0;ДВССЫЛ("E" & ПОИСКПОЗ(A3;$D$1:$D$7;0))-B3;0)

Sub SumBad()
    Dim WK As Workbook
    Dim WS As Worksheet
    Dim Bad_Sum As Integer
    
    Set WK = Excel.ActiveWorkbook
    Set WS = WK.ActiveSheet
    
    Bad_Sum = 0
    ' Перебор строк
    For r = 2 To 7
        ' Перебор столбцов
        For c = 6 To 8
            If WS.Cells(r, c).Style = "Плохой" And IsNumeric(WS.Cells(r, c)) Then
                Bad_Sum = Bad_Sum + WS.Cells(r, c)
            End If
        Next c
    Next r
    
    ' Вывод результата
    WS.Cells(9, 6) = Bad_Sum
End Sub