Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
25.01.2021, 03:28:36

Войти
Интересные и полезные статьи по работе с Excel и VBA можно найти в разделе ХИТРОСТИ
31 743 Сообщений в 5 102 Тем от 11 624 Пользователей
Последний пользователь: atoboqah
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Макрос поиск файла по части имени и переименование листа по части имени
Страниц: [1]   Вниз
Печать
Автор Тема: Макрос поиск файла по части имени и переименование листа по части имени  (Прочитано 155 раз)
0 Пользователей и 1 Гость смотрят эту тему.
carsmaster
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 3


Просмотр профиля
« : 14.01.2021, 12:58:42 »

Здравствуйте всем.
Создал макрос, который ищет в папке "88888" текстовый файл с данными по части названия "_Data", открывает его и сохраняет
как TEST_Data.xls . Так же макрос ищет в созданном файле TEST_Data.xls лист так-же по части названия "_Data"
и переименовывает этот лист в лист с названием "TEST_Data".
Макрос работает нормально, все ищет, создает и переименовывает.
Но вот неприятность, как только я удлинняю путь к тестовику и путь создания фала до "F:\88888\1111"
макрос работает, создает файл TEST_Data.xls , но увы не переименовывает лист в созданном файле.
Тоесть макрос оставляет названия листа с тем полным именем, что нашел файл текстовик.
Тоесть нашел текстовик по части имени "_Data" и с полным именем например "бла-бла-бла_Data" , так и оставляет имя листа в созданном файле "бла-бала-бла_Data". А должен как и в работающем макросе переименовать лист в "TEST_Data".

Прошу коррекции макроса.
Спасибо всем , кто откликнется.


Рабочий макрос для работы только с папкой "88888" по пути "F:\88888"
Код: (vb)
 
Sub create()

sFolder = "F:\88888"
sFiles = Dir(sFolder & x & "*_Data.txt")
Do While sFiles <> ""
Workbooks.Open sFolder & sFiles
sFiles = Dir
Loop
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="F:\88888\TEST_Data.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True


Dim i As Integer
For i = 1 To Sheets.Count
If Sheets(i).Name Like "_Data*" Then
Sheets("_Data*").Name = "TEST_Data"
End If
Next i

End Sub



НЕ рабочий макрос для работы по пути "F:\88888\1111"

Код: (vb)

Sub create()

sFolder = "F:\88888\1111"
sFiles = Dir(sFolder & x & "*_Data.txt")
Do While sFiles <> ""
Workbooks.Open sFolder & sFiles
sFiles = Dir
Loop
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="F:\88888\1111\TEST_Data.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True


Dim i As Integer
For i = 1 To Sheets.Count
If Sheets(i).Name Like "_Data*" Then
Sheets("_Data*").Name = "TEST_Data"
End If
Next i

End Sub
« Последнее редактирование: 14.01.2021, 13:17:00 от Дмитрий Щербаков(The_Prist) » Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +458/-0
Офлайн Офлайн

Сообщений: 5 387



Просмотр профиля WWW
« Ответ #1 : 14.01.2021, 13:04:38 »

Прошу внимательно ознакомиться с правилами форума. Вот те пункты, которые Вы нарушили:
1. Название темы должно быть максимально информативным, таким, чтобы уже из названия темы другим пользователям была приблизительно понятна Ваша проблемап.п. 4.2. и 4.14. Правил форума
Придумайте информативное нормальное название и предложите в новом сообщении здесь же в теме или в личную почту мне или модератору.
2. Коды оформляйте тегами VBCode. п.п. 4.25 Правил форума

P.S. Никто кроме Вас пока не знает что хранится в переменной х.
А это вообще бред:
Sheets("_Data*").Name
Если лист не называется именно "_Data*"(со звездочкой) - ничего и не переименуется. Устраните замечания - напишу, как правильно обратитсья.
« Последнее редактирование: 15.01.2021, 07:52:42 от Дмитрий Щербаков(The_Prist) » Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
carsmaster
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 3


Просмотр профиля
« Ответ #2 : 14.01.2021, 13:14:30 »

Спасибо за ответ.
Предлагаю название:
"Макрос поиск файла по части имени и переименование листа по части имени"
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +458/-0
Офлайн Офлайн

Сообщений: 5 387



Просмотр профиля WWW
« Ответ #3 : 14.01.2021, 13:21:25 »

1. x явно должно хоть какое-то значение иметь. В данном конкретном случае - разделитель папок. Возможно, конечно, у Вас где-то выше это константа и тогда из кода строку с назначением ей значения надо будет удалить.
2. Не очень понятно, по какой части сравнивать: то ли до "_Data" должно что-то идти, то ли после. Потому как судя по Вашему описанию до, а по коду - после. Можно сделать и универсальнее - искать есть оно вообще где-то.
Вот так по идее должно работать.
Код: (vb)
Sub create()
x = "\"
sFolder = "F:\88888\1111"
sFiles = Dir(sFolder & x & "*_Data.txt")
Do While sFiles <> ""
Workbooks.Open sFolder & sFiles
sFiles = Dir
Loop
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="F:\88888\1111\TEST_Data.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True

'здесь надо помнить, что лист с "*_Data*" должен быть ТОЛЬКО один
'Иначе получите ошибку, т.к. не может быть двух листов с одинаковым именем
Dim i As Integer
For i = 1 To Sheets.Count
If Sheets(i).Name Like "*_Data*" Then
Sheets(i).Name = "TEST_Data"
End If
Next i 
 
End Sub
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
carsmaster
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 3


Просмотр профиля
« Ответ #4 : 15.01.2021, 07:46:57 »

Большое спасибо за ответ. Пока не работает, пытаюсь понять почему.

Комментарий администратора Не цитируйте сообщения полностью - достаточно выделить нужную фразу и нажать ЦИТИРОВАТЬ. п.п. 4.18 Правил форума
Прочитайте уже правила полностью
« Последнее редактирование: 15.01.2021, 07:52:19 от Дмитрий Щербаков(The_Prist) » Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru