| Код |
|---|
Sub Razbivka_Kod_Seriya_Mip_Inv()
Dim w&, i&, ob&, LR&, c&, LC&
Dim B(), D(), E(), R(), S(), U(), N() As Variant
Dim Line1 As Object
Dim t As Single
Dim j As Worksheet
Dim NomerDokumenta%, KodTovara%, Naimenovanie%, RaznicaKolvo%, RaznicaGrn%, Hozoperaciya%, Napravl%
Set j = Sheets(1)
't = Timer
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
LC = j.Cells(1, Columns.Count).End(xlToLeft).Column
ReDim B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
NomerDokumenta = j.Cells.Find("№ документа").Column
KodTovara = j.Cells.Find("Код товара").Column
Naimenovanie = j.Cells.Find("Наименование товара").Column
RaznicaKolvo = j.Cells.Find("Разница, кол-во").Column
RaznicaGrn = j.Cells.Find("Разница, грн").Column
Hozoperaciya = j.Cells.Find("Хоз.операция").Column
Napravl = j.Cells.Find("Направление").Column
For i = 2 To LR
B(i) = j.Cells(i, NomerDokumenta)
D(i) = j.Cells(i, KodTovara)
E(i) = j.Cells(i, Naimenovanie)
R(i) = j.Cells(i, RaznicaKolvo)
S(i) = j.Cells(i, RaznicaGrn)
U(i) = j.Cells(i, Hozoperaciya)
N(i) = j.Cells(i, Napravl)
Next i
For w = LBound(B) To UBound(B)
For i = LBound(B) To UBound(B)
If IsEmpty(j.Cells(w, LC + 1)) And IsEmpty(j.Cells(i, LC + 1)) Then
If D(w) = D(i) Then
If w < i Then
If (j.Cells(w, RaznicaKolvo) + j.Cells(i, RaznicaKolvo)) <> 0 Then
If R(w) < 0 And R(i) > 0 Then
If Abs(j.Cells(w, RaznicaKolvo)) > Abs(j.Cells(i, RaznicaKolvo)) Then
If N(w) Like "*МИП*" Or N(w) Like "*ИНВ*" Then
If N(i) Like "*МИП*" Or N(i) Like "*ИНВ*" Then
j.Rows(w + 1).Insert Shift:=xlDown
j.Rows(w + 1).FillDown
j.Cells(w + 1, RaznicaKolvo) = -j.Cells(i + 1, RaznicaKolvo)
j.Cells(w, RaznicaKolvo) = j.Cells(w, RaznicaKolvo) + j.Cells(i + 1, RaznicaKolvo)
j.Cells(w + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 1_" & w
j.Cells(i + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 1_" & w
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
For ob = 2 To LR
B(ob) = j.Cells(ob, NomerDokumenta)
D(ob) = j.Cells(ob, KodTovara)
E(ob) = j.Cells(ob, Naimenovanie)
R(ob) = j.Cells(ob, RaznicaKolvo)
S(ob) = j.Cells(ob, RaznicaGrn)
U(ob) = j.Cells(ob, Hozoperaciya)
N(ob) = j.Cells(ob, Napravl)
Next ob
End If
End If
ElseIf Abs(j.Cells(w, RaznicaKolvo)) < Abs(j.Cells(i, RaznicaKolvo)) Then
If N(w) Like "*МИП*" Or N(w) Like "*ИНВ*" Then
If N(i) Like "*МИП*" Or N(i) Like "*ИНВ*" Then
j.Rows(i + 1).Insert Shift:=xlDown
j.Rows(i + 1).FillDown
j.Cells(i + 1, RaznicaKolvo) = Abs(j.Cells(w, RaznicaKolvo))
j.Cells(i, RaznicaKolvo) = j.Cells(i, RaznicaKolvo) + j.Cells(w, RaznicaKolvo)
j.Cells(w, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 2_" & w
j.Cells(i + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 2_" & w
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
For ob = 2 To LR
B(ob) = j.Cells(ob, NomerDokumenta)
D(ob) = j.Cells(ob, KodTovara)
E(ob) = j.Cells(ob, Naimenovanie)
R(ob) = j.Cells(ob, RaznicaKolvo)
S(ob) = j.Cells(ob, RaznicaGrn)
U(ob) = j.Cells(ob, Hozoperaciya)
N(ob) = j.Cells(ob, Napravl)
Next ob
End If
End If
End If
ElseIf R(w) > 0 And R(i) < 0 Then
If Abs(j.Cells(w, RaznicaKolvo)) > Abs(j.Cells(i, RaznicaKolvo)) Then
If N(w) Like "*МИП*" Or N(w) Like "*ИНВ*" Then
If N(i) Like "*МИП*" Or N(i) Like "*ИНВ*" Then
j.Rows(w + 1).Insert Shift:=xlDown
j.Rows(w + 1).FillDown
j.Cells(w + 1, RaznicaKolvo) = -j.Cells(i + 1, RaznicaKolvo)
j.Cells(w, RaznicaKolvo) = j.Cells(w, RaznicaKolvo) + j.Cells(i + 1, RaznicaKolvo)
j.Cells(w + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 3_" & w
j.Cells(i + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 3_" & w
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
For ob = 2 To LR
B(ob) = j.Cells(ob, NomerDokumenta)
D(ob) = j.Cells(ob, KodTovara)
E(ob) = j.Cells(ob, Naimenovanie)
R(ob) = j.Cells(ob, RaznicaKolvo)
S(ob) = j.Cells(ob, RaznicaGrn)
U(ob) = j.Cells(ob, Hozoperaciya)
N(ob) = j.Cells(ob, Napravl)
Next ob
End If
End If
ElseIf Abs(j.Cells(w, RaznicaKolvo)) < Abs(j.Cells(i, RaznicaKolvo)) Then
If N(w) Like "*МИП*" Or N(w) Like "*ИНВ*" Then
If N(i) Like "*МИП*" Or N(i) Like "*ИНВ*" Then
j.Rows(i + 1).Insert Shift:=xlDown
j.Rows(i + 1).FillDown
j.Cells(i + 1, RaznicaKolvo) = -j.Cells(w, RaznicaKolvo)
j.Cells(i, RaznicaKolvo) = j.Cells(i, RaznicaKolvo) + j.Cells(w, RaznicaKolvo)
j.Cells(w, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 4_" & w
j.Cells(i + 1, LC + 1) = "Разбивка/Код/Серия/МИП/ИНВ 4_" & w
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
ReDim B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
For ob = 2 To LR
B(ob) = j.Cells(ob, NomerDokumenta)
D(ob) = j.Cells(ob, KodTovara)
E(ob) = j.Cells(ob, Naimenovanie)
R(ob) = j.Cells(ob, RaznicaKolvo)
S(ob) = j.Cells(ob, RaznicaGrn)
U(ob) = j.Cells(ob, Hozoperaciya)
N(ob) = j.Cells(ob, Napravl)
Next ob
End If
End If
End If
End If
End If
End If
End If
End If
Next i
LR = j.Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve B(1 To LR), D(1 To LR), E(1 To LR), R(1 To LR), S(1 To LR), U(1 To LR), N(1 To LR) As Variant
For ob = 2 To LR
B(ob) = j.Cells(ob, NomerDokumenta)
D(ob) = j.Cells(ob, KodTovara)
E(ob) = j.Cells(ob, Naimenovanie)
R(ob) = j.Cells(ob, RaznicaKolvo)
S(ob) = j.Cells(ob, RaznicaGrn)
U(ob) = j.Cells(ob, Hozoperaciya)
N(ob) = j.Cells(ob, Napravl)
Next ob
Debug.Print w
Next w
'MsgBox (Timer - t) / 60
End Sub
|
Пример: есть цикл от 1 до 10. Через каждые 2 -е единицы добавляется еще 1. По итогу получим 15. Код при этом доходит до 10-и и завершает работу.
Укажите огненной дланью на путь истинный. Не дайте сгинуть в безвестности.
PS: В программировании деревянный. Прошу не пинать. Спасибо заранее.
