Всем привет.
Прошу помочь со следующей задачей.
есть файл с данными, который необходимо разделить на, порядка, 32000 файлов для рассылки сответствующим клиентам.
Файл следует разделить по признаку "Зона доставки" (в примере залит желтым цветом) и этой же зоной доставки назвать разрезанный файл.
Кол-во зон доставок разное, а значит и файл должен делиться на файлы с разным кол-вом строк.
На просторах инета нашел решение похожей задачи, но там начало и конец среза ознаменованы конкретными словами ("всего" и "контрагент" ) .
Вполне возможно его можно адаптировать под мою задачу, но у меня не хватает знаний...
Прошу помочь со следующей задачей.
есть файл с данными, который необходимо разделить на, порядка, 32000 файлов для рассылки сответствующим клиентам.
Файл следует разделить по признаку "Зона доставки" (в примере залит желтым цветом) и этой же зоной доставки назвать разрезанный файл.
Кол-во зон доставок разное, а значит и файл должен делиться на файлы с разным кол-вом строк.
На просторах инета нашел решение похожей задачи, но там начало и конец среза ознаменованы конкретными словами ("всего" и "контрагент" ) .
Вполне возможно его можно адаптировать под мою задачу, но у меня не хватает знаний...
| Код |
|---|
Sub ertert()
Dim fn As String, wsh As Worksheet, wb As Object
Dim r As Range, rr As Range, s As String, ss As String
Application.ScreenUpdating = False
ActiveSheet.Copy Before:=Sheets(1)
Set wsh = ActiveSheet: s = "ВСЕГО": ss = "Контрагент"
With wsh.UsedRange.Columns("B:B")
Do
Set r = .Find(s, lookat:=xlWhole)
If Not r Is Nothing Then
With .Cells(1, 1).Resize(r.Row)
Set rr = .Find(ss, lookat:=xlWhole)
If Not rr Is Nothing Then
fn = ThisWorkbook.Path & "\" & Replace(rr(1, 2), """", "")& "_" & rr(2, 2) & ".xls"
Set wb = Workbooks.Add
.EntireRow.Copy
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
wb.SaveAs fn, xlNormal: DoEvents: wb.Close
End If
.EntireRow.Delete
End With
End If
Loop Until r Is Nothing
End With |
Изменено: - 02.03.2015 11:14:18
