Доброй ночи!
Пытаюсь настроить макрос для разбивки данных листа на файлы.
Столбцов на листе 10, а вот строк ~ 100 000.
Принцип разбивки на файлы: берется столбец, из уникальных значений к-ого формируется заголовок будущего файла и в этой формирующийся файл попадаются строки из исходного файла только с указанным значением в столбце.
Пробовал разные вариант:
1 вариант - пользуюсь давно, все ок, но при объеме > 50 000 строк макрос о-о-очень подвисает.
2 вариант - пробовал загонять весь объем данных в массив и уже из массива получать нужные значения перебором. работает, но тоже медленно.
3 вариант - пробовал через сводные. Работает быстрее предыдущих вариантов, но сам код получается очень сложным + всякие доп книги приходится создавать и тп.
Подскажите, пож-та, как все-таки лучше в excele обрабатывать такой объем данных?
Может есть другие алгоритмы для данной задачи, более производительные?
Буду признателен за любые подсказки.
==========================================
Вариант 1:
Dim Wb As Workbook
Dim r As range, c As range, BasePath As String
Set r = range(TextBox2.Value & "2", range(TextBox2.Value & "1").End(xlDown))
BasePath = ActiveWorkbook.Path & "\Rezult\"
On Error Resume Next
With New Collection
For Each c In r
.Add 0, c
If Err Then
Err.Clear
Else
ActiveSheet.Copy
range(r.Address).ColumnDifferences©.EntireRow.Delete
Set Wb = ActiveWorkbook
Wb.SaveAs BasePath & c & " - " & TextBox1.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Wb.Close False
Err.Clear
End If
Next
End With
==========================================
Вариант 2 (кусок кода):
Dim МассивДанных() As Variant
Dim i As Long
Dim j As Integer
Dim x As Long
МассивДанных = Sheets("Лист1").range("A1:Z150000").Value
x = 0
For i = 1 To 150000
If МассивДанных(i, 6) = "значение для поиска" Then
For j = 1 To 26
Sheets("Лист2").range(БукваСтолбца(j) & i - x).Value = МассивДанных(i, j)
Next j
Else
x = x + 1
End If
Next i
Erase МассивДанных
==========================================
Вариант 3:
Dim tempWB As Workbook
Dim tempДанные As Worksheet
Dim tempСводная As Worksheet
ActiveSheet.Copy: Set tempДанные = ActiveSheet
tempДанные.Columns(27).Value = ActiveSheet.Columns(6).Value
tempДанные.range("AA1").Value = "x-TEMP-x"
Set tempWB = ActiveWorkbook: tempWB.Sheets.Add
Set tempСводная = tempWB.ActiveSheet
tempWB.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tempДанные.Name & "!R1C1:R5000C" & 26 + 1, Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=tempСводная.Name & "!R1C1", TableName:="СводнаяТаблица", DefaultVersion:=xlPivotTableVersion12
With tempСводная.PivotTables("СводнаяТаблица").PivotFields("Продавец")
.Orientation = xlRowField
.Position = 1
End With
tempСводная.PivotTables("СводнаяТаблица").AddDataField tempСводная.PivotTables _
("СводнаяТаблица").PivotFields("x-TEMP-x"), _
"Количество по полю x-TEMP-x", xlCount
tempСводная.range("B2").ShowDetail = True
Пытаюсь настроить макрос для разбивки данных листа на файлы.
Столбцов на листе 10, а вот строк ~ 100 000.
Принцип разбивки на файлы: берется столбец, из уникальных значений к-ого формируется заголовок будущего файла и в этой формирующийся файл попадаются строки из исходного файла только с указанным значением в столбце.
Пробовал разные вариант:
1 вариант - пользуюсь давно, все ок, но при объеме > 50 000 строк макрос о-о-очень подвисает.
2 вариант - пробовал загонять весь объем данных в массив и уже из массива получать нужные значения перебором. работает, но тоже медленно.
3 вариант - пробовал через сводные. Работает быстрее предыдущих вариантов, но сам код получается очень сложным + всякие доп книги приходится создавать и тп.
Подскажите, пож-та, как все-таки лучше в excele обрабатывать такой объем данных?
Может есть другие алгоритмы для данной задачи, более производительные?
Буду признателен за любые подсказки.
==========================================
Вариант 1:
Dim Wb As Workbook
Dim r As range, c As range, BasePath As String
Set r = range(TextBox2.Value & "2", range(TextBox2.Value & "1").End(xlDown))
BasePath = ActiveWorkbook.Path & "\Rezult\"
On Error Resume Next
With New Collection
For Each c In r
.Add 0, c
If Err Then
Err.Clear
Else
ActiveSheet.Copy
range(r.Address).ColumnDifferences©.EntireRow.Delete
Set Wb = ActiveWorkbook
Wb.SaveAs BasePath & c & " - " & TextBox1.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Wb.Close False
Err.Clear
End If
Next
End With
==========================================
Вариант 2 (кусок кода):
Dim МассивДанных() As Variant
Dim i As Long
Dim j As Integer
Dim x As Long
МассивДанных = Sheets("Лист1").range("A1:Z150000").Value
x = 0
For i = 1 To 150000
If МассивДанных(i, 6) = "значение для поиска" Then
For j = 1 To 26
Sheets("Лист2").range(БукваСтолбца(j) & i - x).Value = МассивДанных(i, j)
Next j
Else
x = x + 1
End If
Next i
Erase МассивДанных
==========================================
Вариант 3:
Dim tempWB As Workbook
Dim tempДанные As Worksheet
Dim tempСводная As Worksheet
ActiveSheet.Copy: Set tempДанные = ActiveSheet
tempДанные.Columns(27).Value = ActiveSheet.Columns(6).Value
tempДанные.range("AA1").Value = "x-TEMP-x"
Set tempWB = ActiveWorkbook: tempWB.Sheets.Add
Set tempСводная = tempWB.ActiveSheet
tempWB.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tempДанные.Name & "!R1C1:R5000C" & 26 + 1, Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=tempСводная.Name & "!R1C1", TableName:="СводнаяТаблица", DefaultVersion:=xlPivotTableVersion12
With tempСводная.PivotTables("СводнаяТаблица").PivotFields("Продавец")
.Orientation = xlRowField
.Position = 1
End With
tempСводная.PivotTables("СводнаяТаблица").AddDataField tempСводная.PivotTables _
("СводнаяТаблица").PivotFields("x-TEMP-x"), _
"Количество по полю x-TEMP-x", xlCount
tempСводная.range("B2").ShowDetail = True
