День добрый.
Знатоки подскажите как можно решить нормаль и правильно задачу.
Имеем кучу книг штук скажем 400 с одинаковым шаблоном ,то есть внутри каждого документа имеется таблица с разными данными клиентов, находится она только в Лист1, а выше и ниже таблички имеем ненужную инфу (одинаковую) пример такого документа прикрепил.
Дальше, количество клиентов в таблице разное, может быть один , а может 20 тыс.
И так задача склеить все книги в одну но при этом что бы клеилось только таблица с клиентами. Я решил задачу, но через задницу, хотелось бы узнать как можно правильно это сделать.
мое решение:
1)
Sub makr1()
Dim myName As String, Wb As Workbook
myName = Dir("c:\in\" & "*.xlsx")
With ThisWorkbook.Sheets(1)
Do While myName <> ""
Set Wb = Workbooks.Open(Filename:="c:\in\" & myName)
ActiveSheet.UsedRange.Copy .Cells(.UsedRange.Rows.Count + .UsedRange.Row, "A")
Wb.Close SaveChanges:=False
myName = Dir
Loop
End With
MsgBox ("Выполнено")
End Sub
---------------------------------
дальше получив книгу со всеми данными начал их фильтровать, а имеено заменять шаблонные надписи в первом столбце на пустые ячейки, что б дальше их грохнуть (напомню пример в приложении)
2)
Sub Makr2()
'
Cells.Replace What:="Чуш", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="что то еще", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Одобрено Мин-чемто", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Код клиента", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
-----------------
А дальше убил все рядки в которых ячейка с первого столбца пустая
3)
Sub DeleteEmptyRowsColumns()
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.Rows®.Columns(1).Value = "" Then Rows®.Delete
Next r
End Sub
--------------------
Одним словом кто знает помогите сделать так что б данные объединялись начиная след рядка после ключевой ячейки "Код клиента" и до первой пустой ячейки.. а дальше начиналась выборка по другой книге точно также... и т.д.
Знатоки подскажите как можно решить нормаль и правильно задачу.
Имеем кучу книг штук скажем 400 с одинаковым шаблоном ,то есть внутри каждого документа имеется таблица с разными данными клиентов, находится она только в Лист1, а выше и ниже таблички имеем ненужную инфу (одинаковую) пример такого документа прикрепил.
Дальше, количество клиентов в таблице разное, может быть один , а может 20 тыс.
И так задача склеить все книги в одну но при этом что бы клеилось только таблица с клиентами. Я решил задачу, но через задницу, хотелось бы узнать как можно правильно это сделать.
мое решение:
1)
Sub makr1()
Dim myName As String, Wb As Workbook
myName = Dir("c:\in\" & "*.xlsx")
With ThisWorkbook.Sheets(1)
Do While myName <> ""
Set Wb = Workbooks.Open(Filename:="c:\in\" & myName)
ActiveSheet.UsedRange.Copy .Cells(.UsedRange.Rows.Count + .UsedRange.Row, "A")
Wb.Close SaveChanges:=False
myName = Dir
Loop
End With
MsgBox ("Выполнено")
End Sub
---------------------------------
дальше получив книгу со всеми данными начал их фильтровать, а имеено заменять шаблонные надписи в первом столбце на пустые ячейки, что б дальше их грохнуть (напомню пример в приложении)
2)
Sub Makr2()
'
Cells.Replace What:="Чуш", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="что то еще", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Одобрено Мин-чемто", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Код клиента", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
-----------------
А дальше убил все рядки в которых ячейка с первого столбца пустая
3)
Sub DeleteEmptyRowsColumns()
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.Rows®.Columns(1).Value = "" Then Rows®.Delete
Next r
End Sub
--------------------
Одним словом кто знает помогите сделать так что б данные объединялись начиная след рядка после ключевой ячейки "Код клиента" и до первой пустой ячейки.. а дальше начиналась выборка по другой книге точно также... и т.д.
