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

Страницы: 1
Ошибка: Can't find project or library - стандартные способы решения не помогли
 
#
25.11.2020 10:59:24
Здравствуйте! Вопрос к знатокам форума. У меня в рабочих файлах периодически возникает ошибка "Can't find project or library". При этом макросы написаны самостоятельно, работаю я на одном и том же компьютере. Ошибка возникает на разных файлах, какой-либо закономерности в причинах я не нашла. Через Tools-References -  подключены только обязательные библиотеки (проверяла). И самое интересное лечится это все тоже очень просто.  Проблемный файл я пересылаю сама себе, открываю его на другом компьютере, снова пересылаю по почте и все работает замечательным образом, никаких изменений в него не вношу. У меня единственное подозрение, что мой основной рабочий компьютер не успевает подключить нужную библиотеку. Может сможете подсказать возможные причины и как эту проблему решить. Спасибо.  
 
Перейти    
Создание отчёта на основе кросс-таблицы
 
#
31.01.2018 11:39:29

Здравствуйте!
Подскажите пожалуйста как ускорить работу этого цикла?. Очень уж медленно получается.

Код
Sub Otchet_SAP() 'начисление и касса заполнение шаблона данных
Dim CompareRange As Variant, x As Variant, y As Variant, SAPdata As Variant, lLast As Variant, kLast As Variant, jLast As Variant
Dim k As Variant, l As Variant
'
   ' jLast = Worksheets("SAP").Cells(Rows.Count, 1).End(xlUp).Row
   ' Worksheets("SAP").Range(Cells(4, 1), Cells(jLast, 21)).ClearContents'k = Worksheets("Imput").Range("h4")
'l = Worksheets("Imput").Range("h9")
Worksheets("BP012_T_ABC").Activate
lLast = Worksheets("BP012_T_ABC").Cells(Rows.Count, 62).End(xlUp).RowSet CompareRange = Worksheets("BP012_T_ABC").Range(Cells(12, 62), Cells(lLast, 62))
Worksheets("SAP").Activate
kLast = Worksheets("SAP").Cells(Rows.Count, 21).End(xlUp).RowSet SAPdata = Worksheets("SAP").Range(Cells(4, 21), Cells(kLast, 21))
     
   i = 4
  For Each x In SAPdata
  For f = 0 To 11
   For Each y In CompareRange
         If x = y Then
            
                  d = y.Offset(0, -27 + f) * y.Offset(0, -29) 'сбор суммы по начислению
                  d1 = d1 + d
                  s = y.Offset(0, 8 + f) 'сбор суммы по кассе
                  s1 = s1 + s '
         'Worksheets("SAP").Cells(i, 1) = k 'год
          Worksheets("SAP").Cells(i, 2) = f + 1 'период
         'Worksheets("SAP").Cells(i, 3) = l 'версия плана
          Worksheets("SAP").Cells(i, 4) = y.Offset(0, -35) 'МВЗ
          Worksheets("SAP").Cells(i, 5) = y.Offset(0, 1) 'Вид затрат
          Worksheets("SAP").Cells(i, 6) = d1 'сумма по начислению
          Worksheets("SAP").Cells(i, 8) = y.Offset(0, -52) ' раздел бюджета
          Worksheets("SAP").Cells(i, 9) = y.Offset(0, -31) 'проект
          Worksheets("SAP").Cells(i, 10) = y.Offset(0, -5) 'заказчик
         'Worksheets("SAP").Cells(i, 12) = k 'год
          Worksheets("SAP").Cells(i, 13) = f + 1 'период
         'Worksheets("SAP").Cells(i, 14) = l 'версия плана
          Worksheets("SAP").Cells(i, 15) = y.Offset(0, 1) 'Вид затрат
          Worksheets("SAP").Cells(i, 16) = s1 'суммы по кассе
          Worksheets("SAP").Cells(i, 17) = y.Offset(0, -52) ' раздел бюджета
          Worksheets("SAP").Cells(i, 18) = y.Offset(0, -31) 'проект
          Worksheets("SAP").Cells(i, 19) = y.Offset(0, -49) 'группа закупок
       End If '
     Next y
       i = i + 1
       s = 0
       s1 = 0
       d = 0
       d1 = 0
     Next f
     Next x
   Worksheets("SAP").Activate
  End Sub

В файле 2 листа , исходные данные и результат как нужно собрать.
Спасибо.
 
Перейти    
Заполнить таблицу с учетом условий выбора, заполнение таблицы по условию с учетом уменьшения остатка количества для выбора
 
#
19.06.2017 15:51:29
Здравствуйте!

Уважаемые форумчане, не могу придумать макрос для заполнения данных таблицы на листе "Заявочка"

Суть вопроса следующая:
Из листа "Логистика" на лист "Заявочка" переносятся данные об остатках товаров на складах. При этом в первую очередь заполняются ячейки при совпадении склада потребности и склада наличия (на пересечении столбец/строка), учитывается также общее количество на складе наличия ( на лист "Заявочка нельзя внести больше чем есть всего по данному складу в наличии) . Этот макрос у меня получился.    (может и кривовато  :) ) .  Мне нужно вытащить в лист "Заявочка" все доступные объемы, даже находящиеся на других складах. Пример того, что должно получиться в итоге приложенном в файле. Заранее спасибо за помощь.
Код
Sub Макрос1() ' заполнение склада
Dim CompareRange As Variant, x As Variant, y As Variant, goory As Variant, z As Variant
Dim k As Integer, l As Integer
    iLast = Worksheets("Заявочка").Cells(Rows.Count, 1).End(xlUp).Row ' последняя строка в диапазоне
    jLast = Worksheets("Логистика").Cells(Rows.Count, 1).End(xlUp).Row
    Set CompareRange = Worksheets("Заявочка").Range(Cells(4, 1), Cells(iLast, 1))
      
     Worksheets("Логистика").Activate
     Worksheets("Логистика").Range(Cells(4, 1), Cells(jLast, 1)).Select
   For Each x In Selection
   For Each y In CompareRange
   If x = y Then
   If y <> 0 Then
   If y.Offset(0, 2) > 0 Then
    For g = 0 To 18
     If y.Offset(0, 3) = Worksheets("Заявочка").Cells(3, 9 + g) Then
     If x.Offset(0, 5) = Worksheets("Заявочка").Cells(3, 9 + g) Then
           z = y.Offset(0, 2)
           If x.Offset(0, 4) >= y.Offset(0, 2) Then
                     If y.Offset(0, 2) + z1 < x.Offset(0, 4) Then
                       y.Offset(0, 8 + g) = y.Offset(0, 2)
                       x.Offset(0, 6) = 1
                     Else
                       If x.Offset(0, 4) - z1 > 0 Then
                          y.Offset(0, 8 + g) = x.Offset(0, 4) - z1
                          x.Offset(0, 6) = 1
                       End If
                     End If
           Else
           
                      If y.Offset(0, 2) + z1 < x.Offset(0, 4) Then
                         y.Offset(0, 8 + g) = y.Offset(0, 2)
                         x.Offset(0, 6) = 1
                       Else
                         If x.Offset(0, 4) - z1 > 0 Then
                            y.Offset(0, 8 + g) = x.Offset(0, 4) - z1
                            x.Offset(0, 6) = 1
                          End If
                       End If
           End If
           z1 = z1 + z
                 End If
           End If
 Next g
  End If
  End If
  End If
               Next y
               z = 0
               z1 = 0
 Next x
   Worksheets("Заявочка").Activate
  End Sub
 
Перейти    
ListBox, возврат и выделение последней обрабатываемой записи
 
#
20.02.2017 07:36:21
 

Здравствуйте! Благодаря форуму разобралась со всеми своими задумками по данной форме. Но есть вопрос, ответ на который я никак найти не могу. Суть такая: обрабатывается файл в 16тыс.наименований (строк), фильтрую по наименованию, записям в нем присваивается нужная группа и класс (выбор в Combobox), но при добавлении изменений в файл Excel и обновлении записей в Listbox-e активной становится первая запись.

 

Как сделать так, что бы запоминалась последняя запись в Listbox-e с которой работали и при обновлении она оставалась выделенной (активной). Ну, что бы по списку не искать. Спасибо.

 
 
Перейти    
Суммирование данных по условию макросом
 
#
22.04.2016 11:02:17
Здравствуйте! Подскажите пожалуйста как обработать следующий запрос макросом:

Есть лист с данными (лист2) - общее количество строк изменяется (до 1500 и более)
порядок столбцов постоянный
лист(1) - форма куда собирается информация
при этом формат листа тоже постоянный (в примере я оставила только значимые поля)

требуется собрать в форму на листе 1 данные с листа 2 при выполнении условия совпадения кода статьи и номера проекта
при этом данные на листе 2  с одинаковыми параметрами могут быть внесены несколькими записями (их нужно сложить)

нарисовала вот такой макрос (все ссылки на реальные диапазоны) :
Код
Sub Макрос12() 
Dim CompareRange As Variant, x As Variant, y As Variant, g As Variant, z As Variant
Dim k As Variant, l As Variant
  z = 0
  z1 = 0
  k = 0
  g = 0
Set CompareRange = Worksheets("Лист1").Range("b15:b700")
Worksheets("Лист2").Activate
Worksheets("Лист2").Range("b3:b1125").Select
 For Each y In CompareRange
 For g = 1 To 15
  k = 1
 If g Mod 4 = 0 Then g = g + 1
       For Each x In Selection
        If x = y Then
        If y <> 0 Then
         If x.Offset(0, -1) = 10100 Then
           z = x.Offset(0, 3 + k)
           z1 = z1 + z
           y.Offset(0, 4 + g) = z1 
                End If
                End If
                End If
           Next x
         z = 0
         z1 = 0
       Next g
       k = k + 1
      Next y
 Worksheets("Лист1").Activate
  End Sub
но он очень медленный, если есть другое решение,
то Большое Вам спасибо!
Изменено: Marlin - 25.04.2016 20:19:56
 
Перейти    
Страницы: 1
Наверх