Sub mmm()
Tim = Timer
sb = ""
Set mb1 = Sheets("Вброс")
Set mb2 = Sheets("Выгрузка")
Set g1 = Sheets("2016")
Set g2 = Sheets("2017")
lim = mb1.Cells(Rows.Count, 1).End(xlUp).Row
lim2 = mb2.Cells(Rows.Count, 1).End(xlUp).Row
Dim a() As String
Dim b() As String
Dim a2() As String
Dim proc As Integer
ReDim a2(1 To lim2, 1 To 8) As String
ReDim b(1 To lim) As String
ReDim a(1 To lim, 1 To 7) As String
god = mb1.Cells(3, 5)
If mb1.Cells(3, 5) = "Выберете год из списка" Then
MsgBox "Год не выбран"
Exit Sub
End If
For J = 1 To Sheets.Count
If Sheets(J).Name = "Нет данных" Then
Sheets(J).Delete
End If
Next J
k = 1
For i = 1 To lim
a(i, 1) = mb1.Cells(i + 1, 1)
a(i, 2) = mb1.Cells(i + 1, 2)
Next i
For i = 1 To lim2
a2(i, 1) = mb2.Cells(i + 1, 1)
a2(i, 2) = mb2.Cells(i + 1, 3)
a2(i, 3) = mb2.Cells(i + 1, 7)
a2(i, 4) = mb2.Cells(i + 1, 6)
a2(i, 5) = mb2.Cells(i + 1, 4)
a2(i, 6) = mb2.Cells(i + 1, 5)
Next i
For i = 1 To lim
For m = 1 To lim2
Find = 0
If a2(m, 1) = a(i, 1) Then
Find = m
Exit For
End If
Next m
If Find = 0 Then
b(k) = a(i, 1)
k = k + 1
GoTo q
Else
a(i, 3) = a2(m, 2)
a(i, 4) = a2(m, 3)
a(i, 5) = a2(m, 4)
a(i, 6) = a2(m, 5)
a(i, 7) = a2(m, 6)
End If
Application.StatusBar = "Процесс 1 из 3. Выполнено: " & Int(100 * i / lim) & "%"
DoEvents
q:
Next i
Application.StatusBar = False
If b(1) <> "" Then
MsgBox "на листе <Нет данных> появились ID показателей. Выгрузите их через транзакцию <Отчет по выгрузке данных КПЭ> и вставьте на лист ВЫГРУЗКА в самый конец. После чего перезапустите макрос"
Sheets.Add
ActiveSheet.Name = "Нет данных"
With Sheets("сумма")
.Columns(1).NumberFormat = "@"
.Range("A1").Resize(UBound(b)) = b
End With
Exit Sub
End If
If god = 2016 Then
g1.Activate
Else: g2.Activate
End If
Cells.Select
Selection.ClearContents
Cells(1, 1).Resize(UBound(a), 7).Value = a
' начнем сбор общего массива
Erase a2
ReDim a2(1 To lim2, 1 To 8) As String
k = 0
Stroka2014 = 1
Stroka2015 = 1
Stroka2016 = 1
Stroka2017 = 1
god2 = 0
For i = 1 To lim2
If Sheets("2014").Cells(Stroka2014, 1) <> "" Then ' Тупо, но что поделать, не придумал еще
For n = 1 To 7
a2(i, n) = Sheets("2014").Cells(Stroka2014, n)
Next n
Stroka2014 = Stroka2014 + 1
GoTo nex
ElseIf Sheets("2015").Cells(Stroka2015, 1) <> "" Then
For n = 1 To 7
a2(i, n) = Sheets("2015").Cells(Stroka2015, n)
Next n
Stroka2015 = Stroka2015 + 1
GoTo nex
god2 = 1
ElseIf Sheets("2016").Cells(Stroka2016, 1) <> "" Then
Sheets("2016").Activate
For n = 1 To 7
a2(i, n) = Sheets("2016").Cells(Stroka2016, n)
Next n
Stroka2016 = Stroka2016 + 1
GoTo nex
ElseIf god = "2017" And Sheets("2017").Cells(Stroka2017, 1) <> "" Then
Sheets("2017").Activate
For n = 1 To 7
a2(i, n) = Sheets("2017").Cells(Stroka2017, n)
Next n
Stroka2017 = Stroka2017 + 1
GoTo nex
End If
nex:
' конец сбора
Application.StatusBar = "Процесс 2 из 3. Выполнено: " & Int(100 * i / lim2) & "%"
DoEvents
Next i
MsgBox Timer - Tim
For i = 1 To UBound(a2)
a2(i, 8) = LCase(SpecTrim(a2(i, 3), mb1.Range("o1"))) & a2(i, 5)
Next i
End Sub
|
