Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Дмитрий Бобровников
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1 2 3 4 5 След.
Модуль классов для нескольких Scrollbar'ов на листе excel
 
#
06.08.2015 11:30:26
Спасибо)))) Заработало))))
 
Перейти    
Модуль классов для нескольких Scrollbar'ов на листе excel
 
#
06.08.2015 11:14:11
Добрый день,
Не могу понять почему не работает макрос. На листе есть много Scrollbar'ов. Чтобы не прописывать для каждого свои действия, решил создать класс описывающий действия для них. Но он не работает. Не могу понять почему.
Делал на примере описанном на http://www.excel-vba.ru/chto-umeet-excel/rabota-s-modulyami-klassov/.
 
Перейти    
Ошибка - Слишком много форматов ячеек, Excel 2010 - ошибка - слишком много форматов ячеек
 
#
21.05.2015 14:08:04
а тут были? -http://www.planetaexcel.ru/techniques/9/211/
 
Перейти    
Преобразование массива по условию (VBA)
 
#
04.02.2015 13:13:50
Alexander88, спасибо за ссылку
 
Перейти    
Преобразование массива по условию (VBA)
 
#
04.02.2015 12:58:03
После подсказки JeyCi, родил такой код (скорее попытался применить для моего случая код JeyCi из ссылке постом выше)  :
Код
Sub summ_dic()
Dim arr_1 As Variant, i&

x = 40

With Sheets("Лист1")
    arr_1 = .Range("D5:K36").Value
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = arr_1(i, 1)
    Next i
    Sheets("Лист1").Cells(x, 14).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = arr_1(i, 2)
    Next i
    Sheets("Лист1").Cells(x, 15).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = arr_1(i, 3)
    Next i
    Sheets("Лист1").Cells(x, 16).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = arr_1(i, 4)
    Next i
    Sheets("Лист1").Cells(x, 17).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) + arr_1(i, 6)
    Next i
    Sheets("Лист1").Cells(x, 19).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr_1)
        .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) = .Item(arr_1(i, 1) & arr_1(i, 2) & arr_1(i, 3)) + arr_1(i, 7) + arr_1(i, 8)
    Next i
    Sheets("Лист1").Cells(x, 20).Resize(.Count, 1).Value = Application.Transpose(Array(.items))
End With
With Sheets("Лист1")
    For x = 40 To 56
        .Cells(x, 18) = .Cells(x, 20) - .Cells(x, 19)
    Next
End With
    
End Sub
Он в принципе работает, но думаю его можно сократить...
Может кто поможет.
Еще не понимаю как присвоить значение остатков материала после первого месяца.
Изменено: Дмитрий Бобровников - 04.02.2015 13:01:02
 
Перейти    
Преобразование массива по условию (VBA)
 
#
04.02.2015 10:24:14
Спасибо
 
Перейти    
Преобразование массива по условию (VBA)
 
#
04.02.2015 10:07:50
JeyCi, спасибо за наводку, буду искать.

Можете на моем примере показать хотя бы как просуммировать потребности материалов на каждый месяц по приборам?
 
Перейти    
Преобразование массива по условию (VBA)
 
#
03.02.2015 17:09:05
Добрый вечер,
Нужна помощь в обработке массива данных.
В файле в качестве примера выложена часть массива, который собирается с нескольких листов. Массив отсортирован по дате. Необходимо выделить уникальные значения для каждого месяца и прибора, просуммировать значения потребностей для этих месяцев и приборов и произвести дальнейшие манипуляции, которые указаны в файле (текстом сложно объяснить, проще показать в примере).

В итоге должен получится массив как показан в конце листа в файле, который необходимо перенести на лист.
Заранее спасибо.
 
Перейти    
суммирование на нескольких листах по нескольким условиям
 
#
18.12.2014 14:14:30
Leanna, большое человеческое спасибо)))) работает как нужно :)
 
Перейти    
суммирование на нескольких листах по нескольким условиям
 
#
18.12.2014 10:39:00
Попробую объяснить поподробнее,
Цифры при одинаковых сочетаниях "мат." + "пф." всегда одинаковые во всех приборах, но учитывать нужно еще и "метку". И вот если "мат." + "пф."+ "метка" встречается больше 1 раза по всем приборам (+еще в одном приборе они также могут встречаться больше 1 раза). нужно сложить все цифры "остатков" напротив каждого материала.
 
Перейти    
суммирование на нескольких листах по нескольким условиям
 
#
18.12.2014 10:29:44
Новый файл  по просьбе Leanna.
 
Перейти    
суммирование на нескольких листах по нескольким условиям
 
#
18.12.2014 10:14:14
Leanna, Провод ФАЗА Блока КР1706 исключен, так как в приборах он встречается только 1 раз и поэтому в столбце "I" у него стоит 1. Сейчас перевыложу пример с несколькими позициями.

Вячеслав,спасибо, но не правильно, т.к нужно учитывать не только 1 в столбце E, но и общее кол-во этих единиц по всем приборам и если их больше 1 то учитывать при суммировании. Изначально в примере в ячейке С7 стоял правильный ответ (его и хочется получить с помощью формул или макроса.
 
Перейти    
суммирование на нескольких листах по нескольким условиям
 
#
17.12.2014 15:26:09
Добрый день,
Нужна помощь в написании формулы или модуля VBA. Способ решения не принципиален (важен результат).
В примере на листе 1 в ячейке С7 результат, который хотелось бы получить без промежуточных таблиц. Таблица "Пример для  "Провод ПВС 0.5 (белый)"" нарисована для наглядности того что хочется получить в ячейке C7.
 
Перейти    
Поиск дубликатов в строке, макрос VBA
 
#
10.11.2014 14:33:30
Александр Моторин, спасибо большое. То что нужно))))
 
Перейти    
Поиск дубликатов в строке, макрос VBA
 
#
10.11.2014 14:25:01
Сергей, спасибо.
Так я сам могу)). Но мне нужно именно макрос, т.к. данных может быть очень много и такое количество формул будет сильно тормозить файл.
 
Перейти    
Поиск дубликатов в строке, макрос VBA
 
#
10.11.2014 13:54:04
Добрый день,
Помогите решить проблему. На форумах и просторах интернета много тем про поиск и удаление дубликатов в столбцах. Мне же нужно найти дубликаты в 1-ой строке и вывезти уникальные значения во 2-ю строку. Нужен именно макрос, т.к. этим действием будет формироваться шапка таблицы.
Заранее спасибо.
 
Перейти    
Макрос срабатывает только на активном листе
 
#
21.10.2014 12:38:59
Максим Зеленский,Hugo спасибо за помощь. Всё получилось.
The_Prist, буду изучать.... внимательнее)))))
 
Перейти    
Макрос срабатывает только на активном листе
 
#
21.10.2014 12:26:28
Максим Зеленский, а почему Cells бралось на активном, если перед Range стоит указатель с какого листа брать диапазон (ws.)?
 
Перейти    
Макрос срабатывает только на активном листе
 
#
21.10.2014 12:15:19
Hugo, спасибо отработал, но есть одно "но"..... на первол листе 511 значений, нашел 384 уникальных и сформировал список начиная с ячейки AA4 (так и нужно), но на втором листе список записался начиная с ячейки AA1874... третий лист - AA1125...О_о почему так? Причем сам список верный.
 
Перейти    
Макрос срабатывает только на активном листе
 
#
21.10.2014 11:59:09
JayBhagavan, и в первом и во втором случае ничего не происходит (даже если активный лист входит в диапазон).....
 
Перейти    
Макрос срабатывает только на активном листе
 
#
21.10.2014 11:36:35
Добрый день, подскажите пожалуйста, почему данная часть макроса срабатывает только на активном листе, а не на всех указанных:

Код
wsArr = Array("лист1", "лист2", "лист3", "лист4", "лист5", "лист6")

For Each wsName In wsArr

    Set ws = Worksheets(wsName)

    iLastRow = ws.Cells(Rows.Count, 18).End(xlUp).ROW
    'ws.Range("AA4", Cells(iLastRow, 27)).ClearContents
    ReDim avArr(1 To Rows.Count, 1 To 1)
    With New Collection
        On Error Resume Next
        For Each vItem In ws.Range("A4", Cells(iLastRow, 1)).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 ws.Cells(4, 27).Resize(li).Value = avArr

Next
Переменная wsArr задается в начале кода. Дальше происходит выполнение части кода совершенно без каких либо проблем пока не доходит до указанной части. Если активный лист входит в заданный диапазон, код отрабатывает только на нём, если переключится на др. лист вообще ничего не происходит....
 
Перейти    
Формула масива в макросе не хочет переносится в ячейку
 
#
17.09.2014 10:13:08
Доброе утро, помогите пожалуйста разобраться
Почему макрос не воспринимает данную форму записи как формулу массива? Выдает ошибку.
Код
 Worksheets("1").Cells(x, y).FormulaArray = "=SUMPRODUCT('2'!R5C:R9C,TRANSPOSE('3'!RC4:RC8))-VLOOKUP(RC4,'4'!C24:C43,MATCH(R4C,'4'!R4C25:R4C43,0)+1,FALSE)" & _
          "+IF('4'!RC[-1]>0,0,IF((RC[-1]-'5'!RC[-1])<0,RC[-1]-'5'!RC[-1],0))"
Если записывать как обычную формулу, то всё хорошо, так же всё хорошо если записать формулу без условия IF
Код
Worksheets("1").Cells(x, y).FormulaArray = "=SUMPRODUCT('2'!R5C:R9C,TRANSPOSE('3'!RC4:RC8))-VLOOKUP(RC4,'4'!C24:C43,MATCH(R4C,'4'!R4C25:R4C43,0)+1,FALSE)"
 
Перейти    
Визуальное отображение работы "поиск решения" VBA
 
#
15.09.2014 11:54:31
Добрый день
Подскажите пожалуйста, какой параметр в поиске решения указывает на этап выполнения?
В коде:

Код
    ActiveSheet.Range(Cells(5, i), Cells(9, i)).ClearContents    
    bar.Start    
    SolverReset    
    SolverOk SetCell:=Cells(1, i), MaxMinVal:=1, ValueOf:=0, ByChange:=Range(Cells(5, i), Cells(9, i)), _
    Engine:=1, EngineDesc:="GRG Nonlinear"
   
    SolverAdd CellRef:=Range(Cells(5, i), Cells(9, i)), Relation:=4, FormulaText:="öåëîå"   
    SolverAdd CellRef:=Cells(12, i), Relation:=3, FormulaText:="0"   
    SolverAdd CellRef:=Range(Cells(5, i), Cells(9, i)), Relation:=3, FormulaText:="0"  
    SolverAdd CellRef:=Cells(5, i), Relation:=P1, FormulaText:=TextBox2.Value
       SolverAdd CellRef:=Cells(6, i), Relation:=P2, FormulaText:=TextBox3.Value  
    SolverAdd CellRef:=Cells(7, i), Relation:=P3, FormulaText:=TextBox4.Value  
    SolverAdd CellRef:=Cells(8, i), Relation:=P4, FormulaText:=TextBox5.Value
      SolverAdd CellRef:=Cells(9, i), Relation:=P5, FormulaText:=TextBox6.Value  
    SolverOk SetCell:=Cells(1, i), MaxMinVal:=1, ValueOf:=0, ByChange:=Range(Cells(5, i), Cells(9, i)), _
    Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverOk SetCell:=Cells(1, i), MaxMinVal:=1, ValueOf:=0, ByChange:=Range(Cells(5, i), Cells(9, i)), _
    Engine:=1, EngineDesc:="GRG Nonlinear"
       
    bar.Update           
    SolverSolve True  
    Set bar = Nothing
Для прогресс бара необходимо указать по какому параметру его обновлять. В поиске решения какой параметр за это отвечает и как его добавить в :
Код
bar.Update
И еще вопрос, почему когда я задаю целые значения для изменяемых ячеек, макрос всё равно выдает результат с не целыми числами?

Прогресс бар взял отсюда http://office-menu.ru/index.php/inye-kategorii/gotovye-resheniya/42-progressbar-sozdanie-polosy-zagruzki-na-vba
Изменено: Дмитрий Бобровников - 15.09.2014 12:47:14 (Добавил источник прогресс бара)
 
Перейти    
Поиск решения через UserForm, VBA
 
#
11.09.2014 13:24:13
Добрый день
Помогите, пожалуйста дописать макрос для "поиска решения"
В вызываемом UserForn необходимо прописывать условия для "поиска решения", не могу осилить(((((
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 17:10:05
Сори поторопился....
Всё отлично работает. Еще раз спасибо))))
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 17:07:58
Спасибо, помогло, но частично заголовки формирует (первый цикл), а строки не хочет((((
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 16:51:40
просто там еще есть промежуточный макрос который проверяет на дубликаты, только потом из полученных данных в столбце и в строке формирую конечную таблицу, которую заполняю
Самое важное собрать все элементы с разных таблиц и сформировать строки и столбцы по условиям.
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 16:49:14
собирается на активный пустой лист
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 16:35:02
файл большой, для примера не сократить..
таблица с данными такая же как и в примере http://www.planetaexcel.ru/techniques/9/47/
Выложенный макрос ищет в первом столбце (в макросе в 5) элементы с условием, что они "полуфабрикаты" или "продукция" (19 столбец)  и формирует заголовки на отдельном листе, вторая часть макроса собирает все элементы второго столбца (в макросе в 6) и формирует строки.
Данную процедуру нужно выполнить для нескольких листов (Array() в примере) и собрать все в одну таблицу.
 
Перейти    
Помощь в оптимизации макроса сбора данных с листов по условию VBA, Ругается на переменную iLastRow2 = .Cells(.Rows.Count, 2).End(xlUp).Row
 
#
09.09.2014 16:15:04
Убрал все точки... и ничего не происходит)))) макрос не срабатывает.
 
Перейти    
Страницы: 1 2 3 4 5 След.
Наверх