Есть папка в которую выгружаются файлы с именем "DSC_15.09.14", "DSC_16.09.14" и т.д., данные в них по части форм таблиц - однородны. Хотелось бы иметь файл, в котором бы информация из этих файлов агрегировались.
Т.е. хотелось бы иметь файл с макросом, который делал бы следующее. 1) Смотрел на забитое мной название файла из которого нужно подтянуть данные (путь, где лежат файлы всегда один). 2) Переносил данные из этого файла в следующую пустую строку (ну, т.е. последовательно продлевался без пропуска строк). Данные всегда берутся с листа с названием "DSC_AGGREGATE". 3) Рядом со скопированными данными проставлял имя файла из которого они скопированы.
Пример прикладываю.
П.С. Прошу понять и простить унылую попытку объясить, что конкретно нужно... - мало того, что только из отпуска вернулся и голова плохо соображает, так еще и заболел :-( П.П.С. Перезалил файлик. 2_2_2 - пример исходника, из которого инфа должна браться. 1_1_1 - агрегированная таблица.
Добрый день, уважаемые гуру!
Помогите, пожалуйста, решить проблему.
Есть папка в которую выгружаются файлы с именем "DSC_15.09.14", "DSC_16.09.14" и т.д., данные в них по части форм таблиц - однородны. Хотелось бы иметь файл, в котором бы информация из этих файлов агрегировались.
Т.е. хотелось бы иметь файл с макросом, который делал бы следующее. 1) Смотрел на забитое мной название файла из которого нужно подтянуть данные (путь, где лежат файлы всегда один). 2) Переносил данные из этого файла в следующую пустую строку (ну, т.е. последовательно продлевался без пропуска строк). Данные всегда берутся с листа с названием "DSC_AGGREGATE". 3) Рядом со скопированными данными проставлял имя файла из которого они скопированы.
Пример прикладываю.
П.С. Прошу понять и простить унылую попытку объясить, что конкретно нужно... - мало того, что только из отпуска вернулся и голова плохо соображает, так еще и заболел :-( П.П.С. Перезалил файлик. 2_2_2 - пример исходника, из которого инфа должна браться. 1_1_1 - агрегированная таблица.ArkaIIIa
Буквально только что задавался подобный вопрос, а если порыться дальше по разделу, то решений - как этого самого... Или сходи к Диме на сайт, там готового кода хватает (если ещё по связанным ссылкам посмотреть).
Буквально только что задавался подобный вопрос, а если порыться дальше по разделу, то решений - как этого самого... Или сходи к Диме на сайт, там готового кода хватает (если ещё по связанным ссылкам посмотреть).AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Понедельник, 22.09.2014, 09:30
AndreTM Если бы это касалось формул - я бы именно так и поступил, но с макросами совсем беда. Я смогу адаптировать код под рабочую (полную) версию своего файла при учете, что код написан под мой пример. Но, увы, я ничего не смогу сделать с кодом, написанным для другой, пусть и схожей, задачи.
AndreTM Если бы это касалось формул - я бы именно так и поступил, но с макросами совсем беда. Я смогу адаптировать код под рабочую (полную) версию своего файла при учете, что код написан под мой пример. Но, увы, я ничего не смогу сделать с кодом, написанным для другой, пусть и схожей, задачи.ArkaIIIa
Увы, так тоже пытается вытащить данные с рабочего стола. Подскажите, пожалуйста, кто знает, куда и что вставить в код, чтобы имя файла, указанное в е1 искалось не на рабочем столе, а в указанной папке:
cPath = ThisWorkbook.Path If Dir(cPath & "/" & cFileName & ".xls") = "" Then MsgBox "Отсутствует файл " & cFileName & ".xls" Exit Sub End If
nRow = Cells(Rows.Count, 4).End(xlUp).Row While nRow > 1 If UCase(Cells(nRow, 4)) = cFileName Then Rows(nRow).Delete End If nRow = nRow - 1 Wend ActiveSheet.UsedRange
Dim oSour As Range Set oDest = Cells(Cells(Rows.Count, 4).End(xlUp).Row + 1, 1) Set oWB = Workbooks.Open(cPath & "/" & cFileName & ".xls", , True) With oWB.Sheets(cSheetName) Set oSour = Intersect(.Columns("A:C"), .UsedRange) End With Set oSour = oSour.Offset(1).Resize(oSour.Rows.Count - 1, oSour.Columns.Count) oSour.Copy oDest oDest.Offset(, 3).Resize(oSour.Rows.Count) = cFileName oWB.Close False
Увы, так тоже пытается вытащить данные с рабочего стола. Подскажите, пожалуйста, кто знает, куда и что вставить в код, чтобы имя файла, указанное в е1 искалось не на рабочем столе, а в указанной папке:
cPath = ThisWorkbook.Path If Dir(cPath & "/" & cFileName & ".xls") = "" Then MsgBox "Отсутствует файл " & cFileName & ".xls" Exit Sub End If
nRow = Cells(Rows.Count, 4).End(xlUp).Row While nRow > 1 If UCase(Cells(nRow, 4)) = cFileName Then Rows(nRow).Delete End If nRow = nRow - 1 Wend ActiveSheet.UsedRange
Dim oSour As Range Set oDest = Cells(Cells(Rows.Count, 4).End(xlUp).Row + 1, 1) Set oWB = Workbooks.Open(cPath & "/" & cFileName & ".xls", , True) With oWB.Sheets(cSheetName) Set oSour = Intersect(.Columns("A:C"), .UsedRange) End With Set oSour = oSour.Offset(1).Resize(oSour.Rows.Count - 1, oSour.Columns.Count) oSour.Copy oDest oDest.Offset(, 3).Resize(oSour.Rows.Count) = cFileName oWB.Close False