[VBA] Работа со списком ссылок

N

Neoneta

Новый пользователь
Сообщения
31
Реакции
1
У меня есть файл эксель "Реестр".
В нем есть:
1 колонка - ссылки на файлы эксель где хранится информация с несколькими листами каждый (фио, телефон, история операций клиента).
2 колонка - персональный код этих клиентов (у всех разный) .
Файл на 300строк.
Мне нужно скопировать персональный код в колонке 2, перейти по ссылке в колонке 1 и внести скопированое в файл что открылся на лист "Данные" в ячейку С1.
Есть ли метод сделать это быстро, не кликая на каждую ссылку?
 
Пришлите пример первого файла (1 строчку), где будет видно как выглядит эта ссылка.
 
Neoneta написал(а):
Мне нужно скопировать персональный код в колонке 2
Нажмите для раскрытия...
Всё же, как я понял с примера, код в колонке 3.

Вы знакомы с тем, как работать с макросами?
Вам необходимо открыть файл Реестр.xlsx - Файл - Сохранить как... - и пересохранить файл в формате xlsm (с поддержкой макросов).
Затем нажимаете левый Alt + F8, пишите что-нибудь, например MarkAll - создать - перед вами откроется окно редактора - удаляете все что в нем написано, и заменяете на такой код:
VB.NET / VBA: 
Option Explicit

Function FileExists(path As String) As Boolean
    FileExists = (Dir(path) <> "")
End Function

Sub MarkAll()
    Dim personCode As String
    Dim baseSheet As Worksheet
    Dim path As String
    Dim wb As Workbook
    Dim y As Long
    Set baseSheet = ThisWorkbook.ActiveSheet
    For y = 2 To baseSheet.Cells(Cells.Rows.Count, "B").End(xlUp).Row
        path = baseSheet.Cells(y, "B").Value
        If FileExists(path) Then
            Set wb = Workbooks.Open(Cells(y, "B").Value, UpdateLinks:=False)
            If Not (wb Is Nothing) Then
                personCode = baseSheet.Cells(y, "C")
                wb.Sheets("Данные").[C1].Value = personCode
                wb.Close SaveChanges:=True
            End If
        End If
    Next
End Sub

Можете сохраниться, окно редактора можно закрыть.
Чтобы выполнить макрос, жмёте левый Alt + F8, выбираете имя MarkAll - Выполнить.
Макрос последовательно будет открывать книги по ссылкам и заполнять нужное поле.

Важно: перед боевым запуском, сделайте на всякий случай резервную копию книг, указанных в ссылках.
 
Последнее редактирование:
P.S. убедитесь, что в этой строчке кода русские буквы скопировались правильно (иногда они портятся при переносе с форума):
Код: 
wb.Sheets("Данные").[C1].Value = personCode
 
1674936070291.png

Почему-то ругается, жму Debug и выделяет строку FileExists. Может из-за расположения файлов...Работа шла с другого ПК -ссылки были изменены на актуальные, может в этом проблема?
 
Хм, попробуйте заменить ту функцию на такую:
VB.NET / VBA: 
Function FileExists(path As String) As Boolean
    FileExists = CreateObject("Scripting.FileSystemObject").FileExists(path)
End Function
 
То, что открыл - уже хорошо. Давайте разбираться. Я думаю, ему не понравилось название вкладки.
Если у вас вкладка "Данные" всегда идёт первым листом (и в книге нет других скрытых листов перед ней), то можно указать лист по порядковому номеру.
Попробуйте заменить строчку с ошибкой на такую строчку:
Код: 
wb.Sheets(1).[C1].Value = personCode
Если у вас этот лист под другим порядковым номером, то замените цифру 1 на нужный номер.

P.S. Так и есть, присмотрелся к скриншоту, у вас Excel похоже установлен на английскую винду, или траблы с кодировками (и название листа отображается знаками "?????"), так что нужный лист придётся искать по номеру, или другому критерию.
 
Последнее редактирование:
Думаю, вам будет полезно, если в базе будет помечаться заливкой, какие ссылки обработало успешно (помечается зелёным), а какие нет (красным) + сделал, чтобы чуть быстрее открывало, в скрытом режиме:
VB.NET / VBA: 
Option Explicit

Function FileExists(path As String) As Boolean
    Static bInit As Boolean
    Static oFSO As Object
    If Not bInit Then
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        bInit = True
    End If
    FileExists = oFSO.FileExists(path)
End Function

Sub MarkAll()
    Dim personCode As String
    Dim baseSheet As Worksheet
    Dim path As String
    Dim wb As Workbook
    Dim y As Long
    Dim bSuccess As Boolean
    Set baseSheet = ThisWorkbook.ActiveSheet
    For y = 2 To baseSheet.Cells(Cells.Rows.Count, "B").End(xlUp).Row
        bSuccess = False
        path = baseSheet.Cells(y, "B").Value
        If FileExists(path) Then
            Application.ScreenUpdating = False ' отключаем обновления экрана для ускорения
            Application.EnableEvents = False 'отключаем уведомления
            Application.Calculation = xlCalculationManual 'отключаем расчеты формул
            'Set wb = Workbooks.Open(Cells(y, "B").Value, UpdateLinks:=False)
            Set wb = GetObject(Cells(y, "B").Value) 'открываем в скрытом режиме
            If Not (wb Is Nothing) Then
                personCode = baseSheet.Cells(y, "C")
                wb.Sheets(1).[C1].Value = personCode
                wb.Windows(1).Visible = True 'обязательно восстанавливаем видимость окна, иначе файл будет криво открываться дабл-кликом
                wb.Close SaveChanges:=True
                bSuccess = True
            End If
            Application.ScreenUpdating = True 'восстаналиваем обновление экрана, чтобы было видно заливку
            Application.EnableEvents = True
            Application.Calculation = xlCalculationAutomatic
        End If
        baseSheet.Cells(y, "C").Interior.Color = IIf(bSuccess, vbGreen, vbRed) 'заливка ячейки в зависимости от успеха
    Next
End Sub
 
Последнее редактирование:
спасибо, нужно будет попробовать.
а есть ли возможно вариации этого макроса (без заливок отлично работает) чтоб например открыть по ссылке файл, затем выполнить поиск и замену символов (например год с 2022 на 2023)?
 
Я так на второй лист пробовала вставить формулу с функцией ВПР - но оно вносит как текст, потому вносила без знака равно а теперь хочу сделать замену ("ВПР" на "=ВПР")
 
Neoneta написал(а):
а есть ли возможно вариации этого макроса (без заливок отлично работает) чтоб например открыть по ссылке файл, затем выполнить поиск и замену символов (например год с 2022 на 2023)?
Нажмите для раскрытия...
Можно. У макросов практически безграничные возможности, поэтому подобные книги, скачанные с макросами не пойми откуда, следует запускать с опаской.

Лайфхак: Автоматизация задач с помощью средства записи макросов — Excel - Служба поддержки Майкрософт
запускаете "Запись макросов", делаете вручную то, что нужно, останавливаете запись, ALT + F11 для открытия окна IDE (клик по Module1), и в нём уже готовый код, правда будет много мусора, но суть запишет.

Вот замена (в принципе всё взято с магнитофона, полностью корректно записало):
VB.NET / VBA: 
Cells.Replace What:="2022", Replacement:="2023", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Чтобы заменить в нужной (открытой по ссылке книги), просто подставьте объект-ссылку в начало команды:
VB.NET / VBA: 
wb.Sheets(1).Cells.Replace What:="2022", Replacement:="2023", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
(для замены на 1-м листе)
Надеюсь, куда эту команду вставить догадаетесь сами.

Neoneta написал(а):
Я так на второй лист пробовала вставить формулу с функцией ВПР - но оно вносит как текст, потому вносила без знака равно а теперь хочу сделать замену ("ВПР" на "=ВПР")
Нажмите для раскрытия...
Для этого нужно использовать чуть другое свойство: .FormulaR1C1 = "" (если используете универсальные, т.е. на англ. языке формулы), или .FormulaR1C1Local = "" (если локализованные, на языке установленного Excel, как у вас выше).
VB.NET / VBA: 
wb.Sheets(2).[C1].FormulaR1C1Local = "=ВПР"
(вставит часть формулы =ВПР в ячейку C1 листа № 2 книги-объекта wb)
 
Последнее редактирование:
Ого... Спасибо, надо выкроить время чтоб внедрить на копиях файлов. Вам большое спасибо за такую ценую информацию!
 
Назад
Сверху Снизу