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 Subprocedure TForm1.FormCreate(Sender: TObject);
begin
form1.hide;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
form2.Show;
end;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
Dim mark_array
mark_array = Array(Me.mark0, Me.mark1)
Me.mark [i]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=СЦЕПИТЬ("images/"; A1)Dim WB As Workbook
Dim WS As Worksheet
Set WB = Excel.ActiveWorkbook
Set WS = WB.ActiveSheet
' Вместо 5 указать действительное количество строк
For r = 1 To 5
' Вместо 1 указать номер ячейки, в которой нужно провести изменения
WS.Cells(r, 1) = "images/" & WS.Cells(r, 1)
Next r