Доброй ночи мастерам макросов и сложных вычислений. В очередной раз окунувшись с головой в непростую науку постижения и использования макросов бьюсь со следующей задачкой: На основе игр с юзер формой и фильтрами получаю некий массив данных в listbox (это получилось) на основе его необходимо осуществить поиск с суммированием по разношерстным листам, ключи поиска (названия листов) представлены в массиве, вот чешу репку и прикинуть не могу дальше быть.........
Скрытый текст
Код
кусок рабочего кода, но с ним проблем нет=выложу позднее итоговый файл с решением задачки как докручу
Dim iCond(), iFilter1(), iFilter2(), iFilter3(), iFilter4(), iColumn(), iSheet(), iLeft(), iUp(), iCont(), iFile() As String
Dim iEnbl_1(), iEnbl_2(), iEnbl_3(), iEnbl_4_row(), iEnbl_temp(), iEnbl(), NRow, NFile, NReg, iCount_1, iCount_2, iCount_3, iCount_4, a, iRow() As Integer
Dim CheckVar As Boolean
Private Function GetFileName(myAddress As String) As String
GetFileName = Right(myAddress, Len(myAddress) - InStrRev(myAddress, "\"))
End Function
Private Sub UserForm_Initialize()
NRow = ThisWorkbook.Sheets("Sources").Cells(1, 10).End(xlDown).Row
For i = 1 To NRow
lb_rows.AddItem (ThisWorkbook.Sheets("Sources").Cells(i, 10).Value)
Next i
ob_all_1 = True
CheckVar = False
End Sub
Private Sub ob_select_1_Click()
If ob_select_1 = True Then f_1_2.Visible = True
End Sub
Private Sub ob_all_1_Click()
If ob_all_1 = True Then f_1_2.Visible = False
End Sub
Private Sub Selection1()
x = 0
ReDim iEnbl_1(1 To 1)
For i = 1 To NRow
cond = 0
For j = 1 To a
If ThisWorkbook.Sheets("Sources").Cells(i, 11) = iFilter1(j) Then
cond = 1
Exit For
End If
Next j
If cond = 1 Then
x = x + 1
ReDim Preserve iEnbl_1(1 To x)
iEnbl_1(x) = i
End If
Next i
iCount_1 = x
End Sub
Private Sub cb_filter_rows_Click()
CheckVar = True
Call click_filter_row
lb_rows.Clear
For i = 1 To iCount_1
lb_rows.AddItem (ThisWorkbook.Sheets("Sources").Cells(iEnbl_1(i), 10))
Next i
End Sub
Private Sub click_filter_row()
If ob_all_1 = True Then
a = 0
Else
a = 0
ReDim iFilter1(1 To 1)
If cbfin.Value = True Then
a = a + 1
ReDim Preserve iFilter1(1 To a)
iFilter1(a) = "okl"
End If
If cbnat.Value = True Then
a = a + 1
ReDim Preserve iFilter1(1 To a)
iFilter1(a) = "sd"
End If
End If
If a = 0 Or a = 2 Then
ReDim iEnbl_1(1 To NRow)
For i = 1 To NRow
iEnbl_1(i) = i
Next i
iCount_1 = NRow
Else
Call Selection1
For i = 1 To iCount_2
lb_rows.AddItem (ThisWorkbook.Sheets("Sources").Cells(iEnbl_1(i), 10))
Next i
End If
'------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------------------------
'MsgBox (iCount_2 & ", " & iEnbl(1))
End Sub
Подскажите бобрику люди знающие да ведающие как можно прикрутить или что можно посмотреть или подсмотреть чтобы ручки выправить.
Заранее спасибо большое за уделенное время= всем хорошего настроения.
Юрий хотелось просто не усложнять и не отвлекать, а выложить уже потом целиковую рабочую версию, раз Вам она необходима, то прикладываю. Еще раз спасибо что нашли время.