Страницы: 1
RSS
Запустить старый макрос в новом офисе
 
Добрый день!

Много лет таскаю за собой с работы на работу один жутко удобный макрос - он работает, как ВПР, но может подшивать одновременно несколько столбцов и выдаёт отчёт о расхождениях между исходным целевым листом подшивки.

Марос писан сто лет назад под 32-х разрядный офис.
До сих пор получалось его запустить на 32-х разрядных офисах до 2010-го включительно.

Сейчас на новом месте стоит офис 365 64-х разрядный. Заменить его, к сожалению нельзя.
При установке макроса вылетает ошибка компиляции (см. картинку).

Подскажите, пожалуйста, как таки запустить этот макрос на новом офисе.
 
Zasypich, здравствуйте!
Вот вы молодец, конечно — даже код не прикрепили. Тогда только так

А вообще лучше бы новую тему создали о проблеме — глядишь, вам бы макрос покруче написали  ;)
Изменено: Jack Famous - 10.09.2019 08:52:42
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Не получилось подцепить. Попробую ссылкой на гуглдиск
https://drive.google.com/open?id=1H--ByEFs3yjy7sYEQ4miRgF3xoBijyaH
тут здоровенный набор макросов и инструмент для их установки. из них всех я использую только один "маленькая подшивка"

PS: Прошу прощения - я макросов только пользователь. не всё понимаю :)
Изменено: Zasypich - 10.09.2019 09:40:13
 
Цитата
Zasypich: тут здоровенный набор макросов и инструмент для их установки
а нам нужен только ОДИН и без всяких "инструментов". Найдите тот макрос, по которому у вас вопрос и скопируйте код сюда в сообщение. И не забудьте выделить код соответствующим тэгом на панели <…>
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Вроде это:
Код
Function встав_данн_по_ключевому_столб(ToWBN, Optional Test)
Dim KPI As Boolean
Dim Selection_ As Object
Dim Коллекция As New Collection, item As String, key As String, Extract As String, arr_() As Variant
Dim ToCol As Range, t As Range, F As Range, FromRange As Range
Dim IgnoreH As Boolean
IgnoreH = МаленькаяПодшивка.IgnoreHiddenRows
МаленькаяПодшивка.Hide
If Not IsMissing(Test) Then
    Dim Cell2 As Range, Cell As Range
    For Each Cell2 In Windows(МаленькаяПодшивка.ListBox1.Value).Selection
        If (Not Cell2.EntireRow.Hidden And IgnoreH) Then Коллекция.Add " ", CStr(Cell2.Value)
    Next Cell2
    For Each Cell In Windows(ToWBN).Selection
        If Not MemberExists(Коллекция, Cell.Value) Then Cell.Clear
    Next Cell
    Windows(ToWBN).Activate
    Exit Function
End If
If МаленькаяПодшивка.CheckBox3.Visible And МаленькаяПодшивка.CheckBox3 Then
    KPI = True
    'KPI_встав_данн_по_ключевому_столб ToWBN
    'Exit Function
End If
On Error GoTo endmacros
'If (Res < 0 And проверка_дублей(Selection) < 0) Then MsgBox "Все ключи пусты": Exit Function

If KPI Then Set t = Вернуть_последнюю_неделю(ActiveSheet) Else Set t = Selection
On Error GoTo Ext
Set FromDataCol = Application.InputBox(prompt:="Укажите какие данные должны быть вставлены", Default:=ActiveCell.Address, Type:=8)
On Error GoTo endmacros
If KPI Then Sought = GER(FromDataCol).Offset(-1).Cells(1).Value
'FromData = GER(FromDataCol, Selection).Value
Set FromRange = GER(FromDataCol, t)
FromData = FromRange.Value
FromKey = t.Value
ReDim arr_(UBound(FromKey))
On Error Resume Next
For i = 1 To UBound(FromKey)
    If FromKey(i, 1) = Empty Then GoTo nextkeycell
    If МаленькаяПодшивка.SumOnly Then
        arr_(i) = Application.WorksheetFunction.sum(FromRange.Rows(i))
    Else
        arr_(i) = FromRange.Rows(i).Value
    End If
    'arr_(i) = GER(FromDataCol, Selection).Rows(i).Address
    item = i
    key = FromKey(i, 1)
    Коллекция.Add item, key
nextkeycell: Next i
On Error GoTo 0 'Ext
Workbooks(ToWBN).Activate
On Error Resume Next
If KPI Then
    Set AimR = Вернуть_последнюю_неделю(ActiveSheet) '.Select
    Set ToCol = _
        GRR2(ActiveSheet.Range("раб").Cells(1).EntireRow, Left(Sought, Len(Sought) - 2) & "*")
    On Error GoTo Ext
    If ToCol Is Nothing Then Set ToCol = Application.InputBox("Теперь укажите куда нужно вставить данные:", Type:=8)
Else
    Set AimR = Selection
    Set ToCol = Application.InputBox("Теперь укажите куда нужно вставить данные. Если в книге выделена только 1 ячейка ключевого столбца, то данные будут вставлены в весь столбец.", Type:=8)
End If
If ToCol.Columns.Count <= 0 Then Exit Function
IsRab = CheckName("раб")
'If (Selection.Rows.Count = 1 And IsRab = 0) Then
'       Set AimR = Selection.Cells(1).EntireColumn
'ElseIf (Selection.Rows.Count = 1 And IsRab = 1) Then
'       Set AimR = GER(Selection.Cells(1))
'       If проверка_дублей(GER(Selection.Cells(1))) <> 0 Then
'              Ask2 = MsgBox("Ключевой диапазон в принимающем файле содержит повторяющиеся ключи. Могут быть потеряны нужные данные. Для полной уверенности в безопасности операции нужно выделить только те ключевые ячейки, по которым вы хотите вставить данные. Уверены, что хотите продолжить и вставить в весь столбец?", vbYesNo)
'              If Ask2 = vbNo Then Exit Function
'       End If
'ElseIf Selection.Rows.Count > 1 Then
'       Set AimR = Selection
'End If

Diff = ToCol.Columns(1).Column - Range(AimR.Address).Columns(1).Column
ColumnsCount = FromDataCol.Columns.Count
If МаленькаяПодшивка.CheckBox1.Value <> False Then Range(AimR.Address).Offset(, Diff).Resize(1, ColumnsCount).ClearContents
Dim НетВПолучателе(), НетВПолучателе_ As Long, НетВИсточнике(), НетВИсточнике_ As Long
Dim ЕстьВПолучателе(), ЕстьВПолучателе_ As Long
Application.ScreenUpdating = False
For Each Cell In Range(AimR.Address)
       If Cell = Empty Then GoTo следующая_ячейка
       Extract = Cell
       Err.Number = 0
       Счетчик = Коллекция(Extract)
       If Err.Number = 5 Then
              НетВИсточнике_ = НетВИсточнике_ + 1
              ReDim Preserve НетВИсточнике(НетВИсточнике_)
              НетВИсточнике(НетВИсточнике_) = Extract
              Err.Number = 0
              GoTo следующая_ячейка
       End If
       Cell.Offset(, Diff).Resize(1, IIf(МаленькаяПодшивка.SumOnly = True, 1, ColumnsCount)).Value = arr_(Счетчик) 'собственно вставка!
       ЕстьВПолучателе_ = ЕстьВПолучателе_ + 1
       ReDim Preserve ЕстьВПолучателе(ЕстьВПолучателе_)
       ЕстьВПолучателе(ЕстьВПолучателе_) = Extract
следующая_ячейка:
Err.Clear
Next Cell
If Not МаленькаяПодшивка.CheckBox2.Value = -1 Then GoTo endmacros
ccc = Коллекция.Count
If (НетВИсточнике_ <> 0 Or ЕстьВПолучателе_ <> Коллекция.Count) Then
       If Not МаленькаяПодшивка.CheckBox2.Value = True Then GoTo endmacros
Else
       Exit Function
End If
Workbooks.Add
For i = 1 To ЕстьВПолучателе_
       Коллекция.Remove ЕстьВПолучателе(i)
Next i
If UBound(FromKey) = Коллекция.Count Then GoTo последнее
Cells(1, 1).Value = "Этих ключей нет в файле-получателе:"
Счетчик = 0
For Each элемент_коллекции In Коллекция
       Счетчик = Счетчик + 1
       Cells(Счетчик + 1, 1).Value = FromKey(элемент_коллекции, 1)
       Extract = FromKey(элемент_коллекции, 1)
       счетчик2 = Коллекция(Extract)
       Cells(Счетчик + 1, 1).Offset(, 1).Resize(1, ColumnsCount).Value = arr_(счетчик2)
Next элемент_коллекции
последнее: If НетВИсточнике_ = Empty Then GoTo endmacros
If Cells(2, 1) = Empty Then
       Cells(1, 1) = Empty
       FC_ = 1
Else
       FC_ = Cells(1, 1).End(xlDown).Offset(2).Row
End If
Cells(FC_, 1).Value = "Этих ключей нет в файле-источнике:"
For i = 1 To НетВИсточнике_
       Cells(i + FC_, 1).Value = НетВИсточнике(i)
Next i
Range("a1", "a2").EntireColumn.AutoFit
Ext:
Err.Clear
endmacros:
If Err.Number <> 0 Then MsgBox "Произошла ошибка и, возможно, операция не была завершена корректно."
Application.ScreenUpdating = True
End Function
 
Zasypich, думаю, что в этом коде проблем нет, т.к. нет API-функций, с которыми могут возникать проблемы при смене платформы. А значит, ошибка, скорее всего в неких "установочных" макросах.

Вообще код, мягко говоря, имеет большой простор для улучшений, поэтому думаю, что
Цитата
Jack Famous: лучше бы новую тему создали о проблеме — глядишь, вам бы макрос покруче написали
Изменено: Jack Famous - 10.09.2019 09:59:19
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Zasypich , думаю, что в этом коде проблем нет, т.к. нет API-функций, с которыми могут возникать проблемы при смене платформы. А значит, ошибка, скорее всего в неких "установочных" макросах.
Проще будет новый макрос написать с теми же функциями, чем запустить этот?
 
1. Название темы должно отражать суть задачи, которую выполняет макрос.
2. Проще создать заказ в платной ветке, т.к. писать макрос и еще под него создавать форму пользователя задаром никто не будет.
 
Цитата
vikttur написал:
2. Проще создать заказ в платной ветке, т.к. писать макрос и еще под него создавать форму пользователя задаром никто не будет.
Формы есть
https://drive.google.com/open?id=1K0Efcv15VJkl9LG2RBX1e9zEKb6DMbVT

https://drive.google.com/open?id=1t_qRggJKS5lodr7zXoI9Rq6pbCCXczog
 
ТЗ:

Нужен макрос, который при выборе мышкой диапазона данных в столбце (нескольких ячеек одного столбца) подшивал бы к ним данные с прозвольного количества столбцов другой книги/листа при совпадении наименований и опционально выдавал бы отчёт в виде листа эксель с значениями, которые есть в источнике. но нет в получателе и наоборот - есть в получателе, но нет в источнике.

Работает так:

1) выделяем мышкой несколько ячеек в одном столбце либо целиком столбец
2) нажимаем кнопку макроса
3) выскакивает окно выбора книги источника данных для подшивки
4) выбираем необходимую книгу из всех открытых на данный момент
5) ставим галочку, если необходим отчёт о расхождениях
6) выделяем в книге-источнике диапазон данных для сравнения
7) нажимаем ОК
8) выделяем в книге-источнике необходимые столбцы для вставки (произвольное количество, в идеале не подряд)
9) нажимаем ОК
10) указываем в книге-получателе столбец для вставки первого значения из подшиваемых данных (можно указать любую ячейку необходимого столбца)
11) нажимаем ОК
12) данные из книги-источника подшиваются в необходимое количество столбцоа книги-получателя, как если бы это отработал ВПР, но без Н#Д и прочих ошибок
13) в случае, если подшиваемые данные затирают уже существующие в книге-получателе, выскакивает предупреждение
14) если был отмечен галочкой пункт в форме макроса "Информировать о новых и лишних ключах", создаётся новая книга с перечнем таких ключей.
Изменено: Zasypich - 10.09.2019 13:10:11
 
Цитата
Zasypich: бесплатно не поможет никто
если вы имеете ввиду сделать всё за вас, то вряд ли кто-то возьмётся, потому что ссылку мою из #2 вы, видать, не смотрели. Вот, напоследок, ещё одна
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, Джек, в этой (этой!) ветке только поиск исполнителей. Никаких советов и вариантов.
Ну сколько можно об этом говорить?
 
Цитата
Jack Famous написал:
если вы имеете ввиду сделать всё за вас, то вряд ли кто-то возьмётся, потому что ссылку мою из #2 вы, видать, не смотрели. Вот, напоследок,  ещё одна
Я смотрел, и находил эту тему поиском ранее, но недопетрил как это сделать :(
 
Цитата
Юрий М: в этой (этой!) ветке только поиск исполнителей
и вы, конечно, ни разу не переносили тему из Работы в общую…
Я начал писать ДО переноса. Покидаю…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Я начал писать ДО переноса
Откуда мне было знать?
 
Юрий М, я без претензии, если что)) давайте забудем  ;)
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Zasypich написал:
Сейчас на новом месте стоит офис 365 64-х разрядный. Заменить его, к сожалению нельзя.При установке макроса вылетает ошибка компиляции (см. картинку).Подскажите, пожалуйста, как таки запустить этот макрос на новом офисе.
Вопрос: что за офис 365? Установлен локально или по Web?
Могу посмотреть Ваш файл, высылайте на почту.
Неизлечимых болезней нет, есть неизлечимые люди.
 
Файл старого макроса? В ссылке на гугльдиск выше. Здоровенный файл в архиве "RAO".
офис сегодня уже не посмотрю - уехал с работы :)
думаю, стоит локально, т.к.  смог закинуть файлики макросов в папку макросов экселя.
Изменено: Zasypich - 10.09.2019 13:45:28
 
Куда файл слать? Отправил на почту, с которой получил ссылку.
Файл XLA сконвертирован в  XLAM под 64-битный офис. Проверьте будет ли работать надстройка. Замечания на почту.
Изменено: TheBestOfTheBest - 10.09.2019 14:18:55
Неизлечимых болезней нет, есть неизлечимые люди.
 
Офис 365 MSO (16.0.11629.20238) 64 бит
Изменено: Zasypich - 11.09.2019 04:04:41
 
При выборе файла подшивки в форме макроса, окошко формы остаётся в книге-получателе и не видно в книге источнике.

Т.е. файл для подшивки выбирается, но окошко исчезает.

Приходится возвращаться к книге получателю и нажимать "ОК". И так каждый раз.
 
Задача всё ещё актуальна
Страницы: 1
Наверх