*/
Dim DayOfW As Integer
DayOfW = Weekday(Now, vbMonday)
Dim I, J, D As Integer
Dim ArrB(1 To 3, 1 To 7) As String
Dim ArrA(1 To 21) As String
Dim ArrS(1 To 21) As Boolean
Dim ACount As Integer
Dim ARND As Integer
'сохранение во временные массивы
For J = 1 To 21
ArrA(J) = Sheets("Лист1").Cells(J, 1)
ArrS(J) = False
Next J
For D = 1 To 7
For I = 1 To 3
ArrB(I, D) = Sheets("Лист2").Cells(I + 1, D)
Next I
Next D
ACount = 0
'расчёт повторяющихся значений
For J = 1 To 21
For D = 1 To 21
A1 = (D - 1) Mod 3 + 1
A2 = (D - 1) \ 3 + 1
If ArrA(J) = ArrB(A1, A2) Then
ArrS(J) = True
ACount = ACount + 1
Exit For
End If
Next D
Next J
ACount = 21 - ACount
'расчёт случайного значения по дню недели
For J = 1 To 3
S = ""
ARND = Int((ACount * Rnd) + 1)
For I = 1 To 21
If ArrS(I) = True Then
ARND = ARND + 1
ElseIf ARND = I Then
S = ArrA(I)
ArrS(I) = True
ACount = ACount - 1
End If
Next I
ArrB(J, DayOfW) = S
Next J
'вставка расчётных значений на Лист2
For D = 1 To 7
For I = 1 To 3
Sheets("Лист2").Cells(I + 1, D) = ArrB(I, D)
Next I
Next D
' + сохранение можно добавить чтобы данные о выполненном макросе сохранялись на Листе
ActiveWorkbook.Save
*/
|
