Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Переименование файлов (поиск и сопоставление по списку) - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Переименование файлов (поиск и сопоставление по списку) (Макросы/Sub)
Переименование файлов (поиск и сопоставление по списку)
yuriknsk Дата: Вторник, 09.02.2016, 10:06 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 1 ±
Замечаний: 20% ±

Excel 2016
Приветствую всех гуру мира Excel и VBA. Излагаю свою задачу.

Имеется:
1. много файлов (jpg-фото сотрудников) с маской "аб1-иванов.jpg" (аб2 - номер отдела)
2. Два столбца в excel: первый столбец - "аб1-иванов.jpg"; второй столбец - "Иванов Иван Иваныч". То есть задано соответствие "имя файла" - "ФИО сотрудника"

Необходимо собственно переименовать все файлы на ФИО.jpg

Пробовал через TotalCommander, но там немного по другому реализовано переименование по списку, а тут нужно искать совпадение и сопоставлять найденному имени значение из соседней ячейки, TC не умеет искать, а excel, я уверен, умеет. Только с vba я не очень дружу. Прошу помощи набросать какой-нибудь пример.

Набор файлов:Ссылка удалена! (извиняюсь :) )
[moder]Нарушение п3 Правил форума.[/moder]
К сообщению приложен файл: sample.zip (80.5 Kb)


Сообщение отредактировал yuriknsk - Вторник, 09.02.2016, 10:21
 
Ответить
СообщениеПриветствую всех гуру мира Excel и VBA. Излагаю свою задачу.

Имеется:
1. много файлов (jpg-фото сотрудников) с маской "аб1-иванов.jpg" (аб2 - номер отдела)
2. Два столбца в excel: первый столбец - "аб1-иванов.jpg"; второй столбец - "Иванов Иван Иваныч". То есть задано соответствие "имя файла" - "ФИО сотрудника"

Необходимо собственно переименовать все файлы на ФИО.jpg

Пробовал через TotalCommander, но там немного по другому реализовано переименование по списку, а тут нужно искать совпадение и сопоставлять найденному имени значение из соседней ячейки, TC не умеет искать, а excel, я уверен, умеет. Только с vba я не очень дружу. Прошу помощи набросать какой-нибудь пример.

Набор файлов:Ссылка удалена! (извиняюсь :) )
[moder]Нарушение п3 Правил форума.[/moder]

Автор - yuriknsk
Дата добавления - 09.02.2016 в 10:06
Roman777 Дата: Вторник, 09.02.2016, 11:57 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
yuriknsk, не мой макрос, а Юрий М с http://www.planetaexcel.ru/forum....ge69170
[vba]
Код
Sub ПереименоватьГруппуФайлов()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = "C:\Documents and Settings\Родители\Рабочий стол\Базы\Disks\Дизайны\K&K\kik\"
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) & ".GIF" 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".GIF" 'новое имя
Name OldName As NewName
Next i
End Sub
[/vba]
я его зачем-то изуродовал... переделывая под Вас, хотя достаточно тут
[vba]
Код
Sub ПереименоватьГруппуФайлов()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = ActiveWorkbook.path & "/"
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя
Name OldName As NewName
Next i
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
Сообщениеyuriknsk, не мой макрос, а Юрий М с http://www.planetaexcel.ru/forum....ge69170
[vba]
Код
Sub ПереименоватьГруппуФайлов()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = "C:\Documents and Settings\Родители\Рабочий стол\Базы\Disks\Дизайны\K&K\kik\"
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) & ".GIF" 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".GIF" 'новое имя
Name OldName As NewName
Next i
End Sub
[/vba]
я его зачем-то изуродовал... переделывая под Вас, хотя достаточно тут
[vba]
Код
Sub ПереименоватьГруппуФайлов()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = ActiveWorkbook.path & "/"
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя
Name OldName As NewName
Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 09.02.2016 в 11:57
yuriknsk Дата: Вторник, 09.02.2016, 12:17 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 1 ±
Замечаний: 20% ±

Excel 2016
хм... работает только в случае полного совпадения количества фотографий и количества строк в excel, иначе ошибка "file not found"
это исправимо? :(


Сообщение отредактировал yuriknsk - Вторник, 09.02.2016, 12:18
 
Ответить
Сообщениехм... работает только в случае полного совпадения количества фотографий и количества строк в excel, иначе ошибка "file not found"
это исправимо? :(

Автор - yuriknsk
Дата добавления - 09.02.2016 в 12:17
Roman777 Дата: Вторник, 09.02.2016, 12:24 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
yuriknsk, попробуйте моего "квазимоду"
[vba]
Код
Sub filrename()
Dim i&, i_n&, n&
Dim t As Object
Dim t1() As String
Dim k$, p$
p = ActiveWorkbook.path
Set t = CreateObject("Scripting.Dictionary")
i_n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
  If Cells(i, 1) <> "" Then
     k = Cells(i, 1)
  End If
  If Not t.exists(k) Then
    n = n + 1
    t.Add k, Cells(i, 2)
    ReDim Preserve t1(n)
    t1(n) = k
  End If
Next i
For i = 1 To n
  If Dir(p & "/" & t1(i)) <> "" Then
    Name p & "/" & t1(i) As p & "/" & t(t1(i)) & ".jpg"
  End If
Next i
End Sub
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 09.02.2016, 12:51
 
Ответить
Сообщениеyuriknsk, попробуйте моего "квазимоду"
[vba]
Код
Sub filrename()
Dim i&, i_n&, n&
Dim t As Object
Dim t1() As String
Dim k$, p$
p = ActiveWorkbook.path
Set t = CreateObject("Scripting.Dictionary")
i_n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To i_n
  If Cells(i, 1) <> "" Then
     k = Cells(i, 1)
  End If
  If Not t.exists(k) Then
    n = n + 1
    t.Add k, Cells(i, 2)
    ReDim Preserve t1(n)
    t1(n) = k
  End If
Next i
For i = 1 To n
  If Dir(p & "/" & t1(i)) <> "" Then
    Name p & "/" & t1(i) As p & "/" & t(t1(i)) & ".jpg"
  End If
Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 09.02.2016 в 12:24
yuriknsk Дата: Вторник, 09.02.2016, 12:30 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 1 ±
Замечаний: 20% ±

Excel 2016
ругается на вторую строку: "Compile error: user-defined type not defined"


Сообщение отредактировал yuriknsk - Вторник, 09.02.2016, 12:31
 
Ответить
Сообщениеругается на вторую строку: "Compile error: user-defined type not defined"

Автор - yuriknsk
Дата добавления - 09.02.2016 в 12:30
yuriknsk Дата: Вторник, 09.02.2016, 12:39 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 1 ±
Замечаний: 20% ±

Excel 2016
а вот без этой строки (переменная "f" вообще не используется) работает как надо!

Спасибо! hands
 
Ответить
Сообщениеа вот без этой строки (переменная "f" вообще не используется) работает как надо!

Спасибо! hands

Автор - yuriknsk
Дата добавления - 09.02.2016 в 12:39
Roman777 Дата: Вторник, 09.02.2016, 12:52 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
yuriknsk, Вы правы, f там не нужно было, поправил... сначала думал совсем по-другому выполнять поиск...) потом понял что можно проще)))


Много чего не знаю!!!!
 
Ответить
Сообщениеyuriknsk, Вы правы, f там не нужно было, поправил... сначала думал совсем по-другому выполнять поиск...) потом понял что можно проще)))

Автор - Roman777
Дата добавления - 09.02.2016 в 12:52
yuriknsk Дата: Вторник, 09.02.2016, 13:00 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 40
Репутация: 1 ±
Замечаний: 20% ±

Excel 2016
чет фигня какая-то, все вроде работает, сохраняю книгу sample.xltm потом открываю её, а она называется sample1 и при закрытии предлагает сохранить, как будто книга не сохранена... Ничего не понимаю %)
 
Ответить
Сообщениечет фигня какая-то, все вроде работает, сохраняю книгу sample.xltm потом открываю её, а она называется sample1 и при закрытии предлагает сохранить, как будто книга не сохранена... Ничего не понимаю %)

Автор - yuriknsk
Дата добавления - 09.02.2016 в 13:00
Roman777 Дата: Вторник, 09.02.2016, 13:20 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
yuriknsk, не думаю, что это связано с макросом... расширение должно быть .xls или .xlsm а книгу пытается сохранить, потому что, книга sample1 у вас действительно не сохранена, он (ексель) её копирует почему-то... если у Вас проблема не решится, надо создать отдельную тему для решения данного вопроса.


Много чего не знаю!!!!
 
Ответить
Сообщениеyuriknsk, не думаю, что это связано с макросом... расширение должно быть .xls или .xlsm а книгу пытается сохранить, потому что, книга sample1 у вас действительно не сохранена, он (ексель) её копирует почему-то... если у Вас проблема не решится, надо создать отдельную тему для решения данного вопроса.

Автор - Roman777
Дата добавления - 09.02.2016 в 13:20
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Переименование файлов (поиск и сопоставление по списку) (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!