Цитата |
---|
Пытливый написал: Добрый день. Покажите в файле примере - что вам нужно - какие ячейки каких столбцов каких строк нужно проходить и что при прохождении с ними делать?А то в текстовом режиме очень неудобно помогать. |
Пишу макрос, который на основе уже имеющихся данных заполнял бы пустые ячейки по рангу (проверил на столбце Физ.свойства[5] вроде как работает нормально)
Что делает макрос: ищет максимальное и минимальное значение в нужном диапазоне (в примере: Физ.свойства[5]), а за тем заполняет пустые ячейки в это же диапазоне случайными значениями от минимального до максимального
Что необходимо: заполнить столбцы 5 - 14; 16 - 17; 19; 20; 18 (в данном порядке)
при том: столбец 20 вычисляется как 19 - 21, а столбец 18 = (22 * 21) + 20
Код |
---|
Sub VALcolect_()
Dim EGE As Range, ValList As Range, ExpVal As Range
Dim valARR, FvalARR, i As Long, j&, k&, q&
Set ExpVal = Range("gen[ИГЕ]")
Set ValList = Range("Физ.свойства[18]")
Set EGE = Range("Физ.свойства[0]")
'1.Формуруем набор рангов объекта_______________________________________
Dim vItem, avArr, li As Long
ReDim avArr(1 To Rows.Count, 1 To 1)
With New Collection
On Error Resume Next
For Each vItem In EGE.Value
.Add vItem, CStr(vItem)
If ERR = 0 Then
li = li + 1: avArr(li, 1) = vItem
Else: ERR.Clear
End If
Next
End With
If li Then ExpVal.Resize(li).Value = avArr
'2. Поиск минимального и максимального значения для каждого ранга_______
Erase valARR: Erase FvalARR
ReDim valARR(1 To Rows.Count): ReDim FvalARR(1 To Rows.Count)
On Error Resume Next
For j = 1 To ExpVal.Count
minD = 9999
maxD = -9999
For i = 1 To EGE.Count
If EGE.Cells(i, 1) = avArr(j, 1) Then valARR(i) = ValList.Cells(i)
If valARR(i) <> "" And valARR(i) <> "-" Then
k = k + 1: FvalARR(k) = valARR(i)
If minD > FvalARR(k) Then minD = FvalARR(k)
If maxD < FvalARR(k) Then maxD = FvalARR(k)
End If: Next i
If minD = 9999 Then GoTo nXt
If maxD = -9999 Then GoTo nXt
'3. Заполнение пустых ячеек по рангу____________________________________
For q = 1 To EGE.Count
If EGE.Cells(q, 1) = avArr(j, 1) Then
If IsEmpty(ValList.Cells(q, 1)) Then
ValList.Cells(q, 1).Value = _
Application.RandBetween(minD * 1000, maxD * 1000) / 1000
End If: End If
Next q
Erase valARR: Erase FvalARR
ReDim valARR(1 To Rows.Count): ReDim FvalARR(1 To Rows.Count)
nXt: Next j
End Sub
|