E014 - Формирование сводной таблицы из нескольких листов

Private Sub CommandButton1_Click()
result_page = «»
current_page = 0
result_page = ComboBox1.Text
start_page = Val(TextBox1.Text)
uslov = Trim(TextBox2.Text)

‘ проверка условия для заполнения
If result_page = «» Or start_page = 0 Or uslov = «» Then
MsgBox («Необходимо заполнить все поля с параметрами!»)
Exit Sub
End If

‘ сохранение листа для устраненеие ошибки выполнения длительной операции при обновлении ссылок
ActiveWorkbook.Save

‘ проверка и очистка листа для вывода результатов
On Error Resume Next
Set worksheet_to = Worksheets(result_page)
Set match_range = worksheet_to.Range(«C:C»)
i1 = WorksheetFunction.Match(«Раздел 1. Поступления», match_range, 0)
i2 = WorksheetFunction.Match(«ИТОГО поступления», match_range, 0)
If IsEmpty(i1) Or IsEmpty(i2) Or i1 > i2 Then
MsgBox («Необходимо корректно выбрать лист для вывода результатов!»)
Exit Sub
End If
If i2 — i1 > 1 Then
worksheet_to.Rows(Format(i1 + 1) + «:» + Format(i2 — 1)).Delete
End If
i3 = WorksheetFunction.Match(«Раздел 2. Выплаты», match_range, 0)
i4 = WorksheetFunction.Match(«ИТОГО выплаты», match_range, 0)
If IsEmpty(i3) Or IsEmpty(i4) Or i3 > i4 Then
MsgBox («Необходимо корректно выбрать лист для вывода результатов!»)
Exit Sub
End If
If i4 — i3 > 1 Then
worksheet_to.Rows(Format(i3 + 1) + «:» + Format(i4 — 1)).Delete
End If

‘ определение необходимого количества строк для вставки
count_v = 0
count_p = 0
For current_page = start_page To Worksheets.Count
Set worksheet_from = Worksheets(current_page)
If worksheet_from.Name <> ComboBox1.Text Then
j1 = WorksheetFunction.Match(«Раздел 1. Поступления», worksheet_from.Range(«B:B»), 0)
j2 = WorksheetFunction.Match(«ИТОГО поступления», worksheet_from.Range(«B:B»), 0)
j3 = WorksheetFunction.Match(«Раздел 2. Выплаты», worksheet_from.Range(«B:B»), 0)
j4 = WorksheetFunction.Match(«ИТОГО выплаты», worksheet_from.Range(«B:B»), 0)
For j = j1 + 1 To j4 — 1
If j < j2 Or j > i3 Then
check1 = Not IsEmpty(worksheet_from.Range(uslov + Format(j)).Value)
check2 = worksheet_from.Range(uslov + Format(j)).Value <> 0
check3 = Not IsEmpty(worksheet_from.Range(«B» + Format(j)).Value)
If check1 And (check2 Or check3) Then
If j < j2 Then
count_p = count_p + 1
ElseIf j > j3 Then
count_v = count_v + 1
End If
End If
End If
Next j
End If
Next current_page

‘ вставка необходимого количества строк
i2 = WorksheetFunction.Match(«ИТОГО поступления», match_range, 0)
worksheet_to.Rows(Format(i2) + «:» + Format(i2 + count_p — 1)).Insert Shift:=xlUp
i4 = WorksheetFunction.Match(«ИТОГО выплаты», match_range, 0)
worksheet_to.Rows(Format(i4) + «:» + Format(i4 + count_v — 1)).Insert Shift:=xlUp

‘ копирование данных на лист результата
i2 = WorksheetFunction.Match(«ИТОГО поступления», match_range, 0)
i4 = WorksheetFunction.Match(«ИТОГО выплаты», match_range, 0)
For current_page = start_page To Worksheets.Count
Set worksheet_from = Worksheets(current_page)
Application.StatusBar = «Обработка листа » + worksheet_from.Name
Application.Wait (Now + 0.00001)
If worksheet_from.Name <> ComboBox1.Text Then
j1 = WorksheetFunction.Match(«Раздел 1. Поступления», worksheet_from.Range(«B:B»), 0)
j2 = WorksheetFunction.Match(«ИТОГО поступления», worksheet_from.Range(«B:B»), 0)
j3 = WorksheetFunction.Match(«Раздел 2. Выплаты», worksheet_from.Range(«B:B»), 0)
j4 = WorksheetFunction.Match(«ИТОГО выплаты», worksheet_from.Range(«B:B»), 0)
For j = j1 + 1 To j4 — 1
If j < j2 Or j > j3 Then
check1 = Not IsEmpty(worksheet_from.Range(uslov + Format(j)).Value)
check2 = worksheet_from.Range(uslov + Format(j)).Value <> 0
check3 = Not IsEmpty(worksheet_from.Range(«B» + Format(j)).Value)
If check1 And (check2 Or check3) Then
If j < j2 Then
row_to = i2 — count_p
count_p = count_p — 1
ElseIf j > i3 Then
row_to = i4 — count_v
count_v = count_v — 1
End If
worksheet_to.Range(«B» + Format(row_to) + «:» + «DD» + Format(row_to)) = worksheet_from.Range(«A» + Format(j) + «:» + «DD» + Format(j)).Value
worksheet_to.Cells(row_to, 1) = worksheet_from.Name
End If
End If
Next j
End If
Next current_page
Application.StatusBar = «Готово»
Unload Me
End Sub

 

Private Sub CommandButton2_Click()
Unload Me
End Sub

 

 

Private Sub UserForm_Activate()
Dim current_page As Integer
Dim start_page As String
current_page = 1
Do While current_page <= Application.Worksheets.Count
UserForm1.ComboBox1.AddItem (Worksheets.Item(current_page).Name)
current_page = current_page + 1
Loop
UserForm1.ComboBox1.Text = Worksheets.Item(2).Name
TextBox1.Text = «10»
TextBox2.Text = «AZ»
End Sub

Advertisements