2017-02-20 6 views
-1

Мне нужны тысячи Excel (2016) листов, индексированных на основе значения одной ячейки. В книгах только 1 рабочий лист, и данные всегда существуют в ячейке D2.VBA: 1 ячейка для управления

Я бы хотел, чтобы D2 копировался в главный файл во втором столбце с именем связанного файла в первом. Индивидуальные файлы excel теперь разделяются на подпапки, иногда на 5 папок.

Я действительно новичок в кодировании в целом, поэтому бонусные баллы, если вы сможете объяснить вещи шаг за шагом. Я хотел бы следить и учиться.

Благодарим вас за помощь в продвижении!

редактировать:

Материал я до того активированная листы, измененные файлы, затем активируют другие книги. Я теряюсь, что делать дальше, потому что я не активирую другие рабочие листы, я просто извлекаю данные из них. Их даже не нужно открывать.

Петля должна вызывать файл. , тогда мне нужно: выбрать диапазон> копировать> мастер-файл вызова> активировать> вставить> добавить 1 к строке count для сдвига выбранной ячейки вниз> конец

, но тогда у меня просто куча чисел без имен, поэтому я хотите назвать предыдущую ячейку именем файла файла, из которого она была извлечена. Поиск справки об этом только подталкивает, как назвать ячейку в листе после имени файла или пути, где я хочу это наоборот, и из другого источника, который изменяется каждый раз.

Код для цикла:

Option Explicit 

Sub deeploop() 
Dim objFSO As Object 
Dim objFolder As Object 
Dim objSubFolder As Object 
Dim objFile As Object 
Dim MyFolder As String 
Dim wkbOpen As Workbook 
Dim wkb As Workbook 
Dim wks As Worksheet 
Dim CalcMode As Long 

With Application 
    CalcMode = .Calculation 
    .Calculation = xlCalculationManual 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

'Change path 
MyFolder = "C:\Path" 

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objFolder = objFSO.GetFolder(MyFolder) 
Set wkb = ActiveWorkbook 
Set wks = ActiveSheet 

For Each objSubFolder In objFolder.SubFolders 
    For Each objFile In objSubFolder.Files 
     Set wkbOpen = Workbooks.Open(objFile.Path) 


'code 


     wkbOpen.Close savechanges:=True 
    Next objFile 
Next objSubFolder 

With Application 
    .Calculation = CalcMode 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 


End Sub 
+0

обучение начинается с поиска на поисковых машинно например Excel VBA или макросов, как копировать ... – 0m3r

+0

Я сделал много поиска уже. У меня уже есть код, который может делать цикл, но я не знаю, как объединить отдельные части, поэтому я подумал, что лучше спросить. – Whistler

+0

Прохладный отправьте этот код и сообщите нам, с какой частью у вас проблемы. – 0m3r

ответ

0

Они даже не должны быть открыты

Так что не открывать их!

И просто поставить формулу в своем активном листе, который ссылается на соответствующую ячейку спецификаторы путь к файлу, имя файла и имя листа

предполагающей единственный лист всех тысяч книг Excel назван в честь «Лист1 »вы могли бы действовать следующим образом:

Option Explicit 

Sub deeploop() 
    Dim objFSO As Object 
    Dim objFolder As Object 
    Dim objSubFolder As Object 
    Dim objFile As Object 
    Dim MyFolder As String 
    Dim CalcMode As Long 
    Dim ifile As Long 

    With Application 
     CalcMode = .Calculation 
     .Calculation = xlCalculationManual 
     .ScreenUpdating = False 
     .EnableEvents = False 
    End With 

    'Change path 
    MyFolder = "C:\Path" 

    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFSO.GetFolder(MyFolder) 

    With ActiveSheet.Range("A1:B1") '<--| it suffices to reference the 'ActiveSheet' object since it belongs to 'ActiveWorkbook' by default 
     For Each objSubFolder In objFolder.SubFolders 
      For Each objFile In objSubFolder.Files 

       .Offset(ifile).Value = Array(objFile.Name, "='" & objSubFolder.Path & "\[" & objFile.Name & "]Sheet1'!$D$2") 
       ifile = ifile + 1 

      Next objFile 
     Next objSubFolder 
    End With 

    With Application 
     .Calculation = CalcMode 
     .ScreenUpdating = True 
     .EnableEvents = True 
    End With 
End Sub