Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнить значения первого столбца значением из названия листа
 
#1
27.12.2021 21:48:17
Здравствуйте! Подскажите пожалуйста,  возможно ли реализовать с помощью VBA следующее:
Есть множество книг excel, внутри каждой находятся листы, у листов в качестве имени значится дата. Вопрос , как можно, скопировать название листа в первый столбец (A) , начиная с А2 и растянуть это значение до последней заполненной ячейки в соседнем столбце B ?  У меня к сожалению, так и не получилось найти формулу или написать самому - не вышло...прошу помощи от Гуру.
 
 
 
#2
27.12.2021 22:28:46
нет такой формулы(((
для VBA - это пустячная задача (при наличии сведений о том, где находится это множество книг)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
27.12.2021 22:42:33
Николай PNY, а Вы, случаем, потом эти данные не консолидируте для анализа? Если так - можно все в Power Query сделать.
 
 
 
#4
28.12.2021 00:39:15
прошу прощения, ошибся мне нужна не формула, а понять как написать модуль в VBA...при условии, что допустим все книги находятся по пути C:\Отчеты\2021\Январь.xlsx , внутри этого файла листы с названиями 1.01.2021, 2.02,202 и т.д., и так же другие файлы Февраль.xlsx и другие папки C:\Отчеты\2020\....
Готов рассмотреть любые варианты, powerQuery + VBA, хочу понять как разобраться с такой задачей...нагуглить не получилось, а сроки горят. Столкнулся относительно недавно с реальной работой в excel, но немного уже научился создавать полезные макро, но вот с этой задачей не могу справится...мало времени очень...спасибо всем, кто откликнулся, хочу познать дзен)
 
 
 
#5
28.12.2021 00:49:27
ну, давайте мы вам поможем. Прочитайте комментарии в коде. Какие вопросы у вас возникли?
Код
Sub Test()
    Dim sPath As String, Filename As String, Wb As Workbook

    'путь к папке
    sPath = "C:\Отчеты\2021\"
    If Dir(sPath, vbDirectory) = "" Then
        MsgBox "Нет такой директории: " & sPath, vbExclamation, "Внимание"
        Exit Sub
    End If
    'имя первого найденного файла в указанной папке с расширением xlsx, xlsm, xlsb
    Filename = Dir(sPath & "*.xls*")
    'цикл по всем файлам в указанной папке
    Do While Filename <> ""
        'открываем найденный файл
        Set Wb = Workbooks.Open(Filename:=sPath & Filename, UpdateLinks:=False) ', ReadOnly:=True)
            
        'вот тут что-то делаем с открытым нами файлом
            
        'а теперь закрываем файл
        Wb.Close (True) 'True - сохранить и закрыть, False - не сохранять и закрыть
        'поиск следущего файла в папке
        Filename = Dir
    Loop 'конец цикла    
End Sub
Изменено: New - 28.12.2021 00:50:38
 
 
 
#6
28.12.2021 01:07:00
Цитата
Николай PNY написал:
как написать модуль
Беда у Вас с терминологией: модуль не пишут. Пишут макрос в модуле. А создать сам модуль очень легко: в редакторе меню Insert - Module )
 
 
 
#7
28.12.2021 08:23:02
беда у вас с терминологией:
все файлы находятся в папке С:\Отчеты и во вложенных в ней папках
Изменено: Ігор Гончаренко - 28.12.2021 23:46:01
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#8
28.12.2021 10:10:12
Цитата
написал:
нагуглить не получилось, а сроки горят.
странно Вы гуглите...Да и задача так и не ясна в итоге - нужны имена листов или все данные с листов и признак, с какого листа собраны данные...В общем вот пара ссылок:
Как собрать данные с нескольких листов или книг? - сбор данных с листов и книг с возможностью добавить имя листа и(или) книги к данным
Как получить имя листа формулой - здесь и макрос и формула для получения листа
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
28.12.2021 23:17:31
Спасибо всем откликнувшимся на просьбу! Извините раньше не мог поблагодарить, 2 дня бился над задачей (для меня первая серьезная задача в excel), нужно было из более чем 400 файлов excel, в каждом из которых от 5 до 40 листов с табличными данными, собрать 1 книгу с двумя листами... (таблицы отличались друг от друга: по расположению, количеству колонок и строчек, имели кучу лишних мусорных данных и прочее)
В итоге после написания последнего сообщения сюда, я ушел на ютуб+дальше гуглить и нашел решения своих задач (PowerQuery + несколько макросов + триальные версии надстроек (которые теперь нужно будет приобрести, ввиду их удобства и функциональности). Но еще раз всем спасибо за помощь, за то что откликнулись на зов о помощи! Извините за мою терминологию...писал в спешке с мобильного телефона по пути домой поздно ночью, а в голове был хаос, из-за надвигающегося дедлайна по задаче, с которой не получалось справиться...
Изменено: Николай PNY - 28.12.2021 23:18:36
 
 
 
#10
29.12.2021 00:53:06
положите макросы
Код
Sub Start()
  Dim files&, folders&
  Application.ScreenUpdating = False
  Cells.ClearContents
  folders = 1: GetSheetsName files, folders, _
    CreateObject("Scripting.FileSystemObject"), "C:\Отчеты"
  Application.ScreenUpdating = True
  MsgBox "Done." & vbLf & "Folders = " & folders & vbLf & "Files = " & files
'  Rows(1).Delete
End Sub

Sub GetSheetsName(ByRef fls&, ByRef fds&, Optional fso As Object = Nothing, Optional fdnm$ = "")
  Dim fo, fa, f, a, wb As Workbook, i&
  Set fo = fso.getfolder(fdnm)
  For Each f In fo.files
    If f.Name Like "*.xls*" Then
      Set wb = Workbooks.Open(f.Path)
      ReDim a(1 To wb.Worksheets.Count, 1 To 1)
      For i = 1 To UBound(a)
        a(i, 1) = wb.Worksheets(i).Name
      Next
      wb.Close False: fls = fls + 1
      Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(a), 1) = a
    End If
  Next
  For Each f In fo.subfolders
    GetSheetsName fls, fds, fso, f.Path: fds = fds + 1
  Next
End Sub
в стандартный модуль нового файла. выполните Start
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
Страницы: 1
Наверх