![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Приложения 9⇐ ПредыдущаяСтр 16 из 16
3. Макросы для создания электронных таблиц для создания цепочки таможенных документов
Sub ПУСК() ' Workbooks.Open Filename: =" C: \2\LOTOS\ARTIKUL1.xlsx" Workbooks.Open Filename: =" C: \2\LOTOS\мери.xlsx" Workbooks.Open Filename: =" C: \2\LOTOS\Книга2.xlsx" Range(" A12: O719").Select Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Windows(" мери.xlsm").Activate End Sub Sub qqqqqqq() Windows(" мери.xlsx").Activate For i = 1 To 100 ActiveSheet.Cells(i, 9).Select q = Selection If q < > " " And qq = 0 Then ii = i + 1: qq = 1 If q = " " And qq = 1 Then iii = i - 2: Exit For Next For i = iii To ii Step -1 ActiveSheet.Cells(i, 1).Select q = Selection Do While q = e ActiveSheet.Cells(i, 7).Select Selection = Selection + qwt ActiveSheet.Cells(i, 9).Select Selection = Selection + mvl ActiveSheet.Cells(i, 10).Select Selection = Selection + fr ActiveSheet.Cells(i, 11).Select Selection = Selection + tvl ActiveSheet.Cells(i, 13).Select Selection = Selection + ps ActiveSheet.Cells(i, 14).Select Selection = Selection + wt Rows(i + 1).Delete Exit Do Loop e = q ActiveSheet.Cells(i, 7).Select qwt = Selection ActiveSheet.Cells(i, 8).Select svl = Selection ActiveSheet.Cells(i, 9).Select mvl = Selection ActiveSheet.Cells(i, 10).Select fr = Selection ActiveSheet.Cells(i, 11).Select tvl = Selection ActiveSheet.Cells(i, 13).Select ps = Selection ActiveSheet.Cells(i, 14).Select wt = Selection Next
Windows(" спец.xlsm").Activate End Sub
Sub qwe() Windows(" Книга2.xlsx").Activate Sheets(" Лист1").Select Range(" A12: O719").Select Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone qq = 0 Windows(" мери.xlsx").Activate 'Windows(" ARTIKUL1.xlsx").Activate
sb = 0 For i = 1 To 100 ActiveSheet.Cells(i, 9).Select q = Selection If q < > " " And qq = 0 Then ii = i + 1: qq = 1 If q = " " And qq = 1 Then iii = i - 2: Exit For Next q = 12 For i = ii To iii ActiveSheet.Cells(i, 6).Select qw = Selection Do While qw = " SEE BELOW" vlv = 0 frr = 0 ActiveSheet.Cells(i, 7).Select qwt = Selection ActiveSheet.Cells(i, 8).Select svl = Selection ActiveSheet.Cells(i, 9).Select mvl = Selection ActiveSheet.Cells(i, 10).Select fr = Selection ActiveSheet.Cells(i, 11).Select tvl = Selection ActiveSheet.Cells(i, 13).Select ps = Selection ActiveSheet.Cells(i, 14).Select wt = Selection
ActiveSheet.Cells(i, 1).Select art = Selection Windows(" ARTIKUL1.xlsx").Activate For iq = 3 To 1000 ActiveSheet.Cells(iq, 2).Select artart = Selection Do While artart = art
ActiveSheet.Cells(iq, 3).Select dev = Selection ActiveSheet.Cells(iq, 4).Select tnsmth = Selection ActiveSheet.Cells(iq, 8).Select cntr = Selection ActiveSheet.Cells(iq, 11).Select nam = Selection
ActiveSheet.Cells(iq, 37).Select psb = Selection
ActiveSheet.Cells(iq, 9).Select swt = Selection Exit For Exit Do Loop Next Windows(" Книга2.xlsx").Activate
ActiveSheet.Cells(q, 1).Select Selection = art ActiveSheet.Cells(q, 2).Select Selection = tnsmth ActiveSheet.Cells(q, 3).Select Selection = nam ActiveSheet.Cells(q, 9).Select Selection = Sval
q = q + 1 Windows(" мери.xlsx").Activate wer = 0 For iw = iii To 100 'wer = 0 ActiveSheet.Cells(iw, 1).Select qr = Selection qn = Left(qr, Len(art)) If qn = Left(art, Len(art)) Then qq = iw: wer = 1 If qn = " " And wer = 1 Then qqqqq = iw: Exit For Next For qnab = qq + 2 To qqqqq - 1 ActiveSheet.Cells(qnab, 1).Select artnab = Trim(Selection) ActiveSheet.Cells(qnab, 5).Select svalnab = Selection ActiveSheet.Cells(qnab, 3).Select qwtnab = Selection
Windows(" ARTIKUL1.xlsx").Activate For iq = 3 To 1000
ActiveSheet.Cells(iq, 2).Select artart = Selection Do While artart = Val(artnab)
ActiveSheet.Cells(iq, 3).Select dev = Selection ActiveSheet.Cells(iq, 4).Select tnsmth = Selection ActiveSheet.Cells(iq, 8).Select cntr = Selection ActiveSheet.Cells(iq, 11).Select nam = Selection ee = " " For ewrr = 0 To 16 Step 4 ActiveSheet.Cells(iq, 17 + ewrr).Select e = Selection iqq = 18 Do While e = " 01191" qwei = 2 ActiveSheet.Cells(iq, 18 + ewrr).Select If ee = " " Then ee = Selection: qwei = 1 If ee < > " " And qwei = 2 Then ee = ee & ", " & Selection Exit Do Loop Do While e = 10023 ActiveSheet.Cells(iq, 18 + ewrr).Select eee = Selection erub = 1 Exit Do Loop Next ActiveSheet.Cells(iq, 9).Select swt = Selection
ActiveSheet.Cells(iq, 37).Select 'psb = Selection Exit For Exit Do Loop Next Windows(" Книга2.xlsx").Activate ActiveSheet.Cells(q, 1).Select Selection = artnab ActiveSheet.Cells(q, 2).Select Selection = tnsmth
ActiveSheet.Cells(q, 3).Select Selection = nam
ActiveSheet.Cells(q, 4).Select Selection = cntr
ActiveSheet.Cells(q, 5).Select Selection = dev
ActiveSheet.Cells(q, 6).Select Selection = ee
ActiveSheet.Cells(q, 7).Select If erub = 1 Then Selection = eee erub = 0 ActiveSheet.Cells(q, 8).Select Selection = qwt * qwtnab
ActiveSheet.Cells(q, 9).Select Selection = svalnab
ActiveSheet.Cells(q, 10).Select Selection = Round(qwt * qwtnab * svalnab, 2) vlv = vlv + Selection ActiveSheet.Cells(q, 11).Select Selection = Round(fr * (svalnab * qwtnab / svl), 2) frr = frr + Selection ActiveSheet.Cells(q, 12).Select Selection = Round(fr / svl * svalnab * qwtnab, 2) + Round(qwt * qwtnab * svalnab, 2) ActiveSheet.Cells(q, 13).Select ActiveSheet.Cells(q, 14).Select Selection = qwt * qwtnab * swt q = q + 1 blw = blw + swt
ie = 0 Windows(" мери.xlsx").Activate Next wttt = 0 Windows(" Книга2.xlsx").Activate wttttt = mvl - vlv wtttt = fr - frr wttet = q - 1 For e = 12 To q ActiveSheet.Cells(e, 15).Select ' ee = Selection ActiveSheet.Cells(e, 14).Select ' eee = Selection Do While ee = " " ActiveSheet.Cells(e, 13).Select If wtte = 0 Then wtte = e If Round(qwt / psb * eee / qwt / blw, 0) > wttt Then wtte = e: wttt = Round(qwt / psb * eee / qwt / blw, 0) Selection = Round(qwt / psb * eee / qwt / blw, 0)
ie = ie + Round(qwt / psb * eee / qwt / blw, 0)
ActiveSheet.Cells(e, 15).Select ' Selection = eee * (1 + 1 / (qwt * blw) * (wt - blw * qwt))
Exit Do Loop Next wtt = qwt / psb - ie ActiveSheet.Cells(wtte, 13).Select Selection = Selection + wtt ActiveSheet.Cells(wttet, 10).Select Selection = Selection + wttttt ActiveSheet.Cells(wttet, 11).Select Selection = Selection + wtttt ActiveSheet.Cells(wttet, 12).Select Selection = Selection + wttttt + wtttt
Windows(" мери.xlsx").Activate blw = 0 Exit Do Loop
Do While qw < > " SEE BELOW" ActiveSheet.Cells(i, 1).Select art = Selection ActiveSheet.Cells(i, 7).Select qwt = Selection ActiveSheet.Cells(i, 8).Select svl = Selection ActiveSheet.Cells(i, 9).Select mvl = Selection ActiveSheet.Cells(i, 10).Select fr = Selection ActiveSheet.Cells(i, 11).Select tvl = Selection ActiveSheet.Cells(i, 13).Select ps = Selection ActiveSheet.Cells(i, 14).Select wt = Selection 'Windows(" мери.xlsx").Activate Windows(" ARTIKUL1.xlsx").Activate
For iq = 3 To 1000
ActiveSheet.Cells(iq, 2).Select artart = Selection Do While artart = art
ActiveSheet.Cells(iq, 3).Select dev = Selection ActiveSheet.Cells(iq, 4).Select tnsmth = Selection ActiveSheet.Cells(iq, 8).Select cntr = Selection ActiveSheet.Cells(iq, 11).Select nam = Selection ActiveSheet.Cells(iq, 17).Select e = Selection iqq = 18 ee = " " For ewrr = 0 To 16 Step 4 ActiveSheet.Cells(iq, 17 + ewrr).Select e = Selection iqq = 18 Do While e = " 01191" qwei = 2 ActiveSheet.Cells(iq, 18 + ewrr).Select If ee = " " Then ee = Selection: qwei = 1 If ee < > " " And qwei = 2 Then ee = ee & ", " & Selection Exit Do Loop Do While e = 10023 ActiveSheet.Cells(iq, 18 + ewrr).Select eee = Selection erub = 1 Exit Do Loop Next
ActiveSheet.Cells(iq, 9).Select swt = Selection Exit For
Exit Do Loop Next Windows(" Книга2.xlsx").Activate ActiveSheet.Cells(q, 1).Select Selection = art ActiveSheet.Cells(q, 2).Select Selection = tnsmth
ActiveSheet.Cells(q, 3).Select Selection = nam
ActiveSheet.Cells(q, 4).Select Selection = cntr
ActiveSheet.Cells(q, 5).Select Selection = dev
ActiveSheet.Cells(q, 6).Select Selection = ee
ActiveSheet.Cells(q, 7).Select If erub = 1 Then Selection = eee erub = 0 ActiveSheet.Cells(q, 8).Select Selection = qwt
ActiveSheet.Cells(q, 9).Select Selection = svl
ActiveSheet.Cells(q, 10).Select Selection = mvl ActiveSheet.Cells(q, 11).Select Selection = fr
ActiveSheet.Cells(q, 12).Select Selection = tvl ActiveSheet.Cells(q, 13).Select Selection = ps
ActiveSheet.Cells(q, 14).Select Selection = qwt * swt
ActiveSheet.Cells(q, 15).Select Selection = wt q = q + 1
Exit Do Loop Windows(" мери.xlsx").Activate ' Windows(" ARTIKUL1.xlsx").Activate
Next Windows(" Книга2.xlsx").Activate ActiveSheet.Cells(q + 1, 2).Select
Selection = " Группировка по коду ТНВЭД" Range(Cells(q + 1, 2), Cells(q + 1, 2)).Select With Selection.Font .Name = " Calibri" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Selection.Font.Bold = True ActiveSheet.Cells(q + 2, 2).Select Selection = " Код ТНВЭД» ActiveSheet.Cells(q + 2, 4).Select Selection = " Страна" ActiveSheet.Cells(q + 2, 8).Select Selection = " Кол-во" ActiveSheet.Cells(q + 2, 10).Select Selection = " Стоимость" ActiveSheet.Cells(q + 2, 11).Select Selection = " Фрахт" ActiveSheet.Cells(q + 2, 12).Select Selection = " Стоимость, Итого" ActiveSheet.Cells(q + 2, 13).Select Selection = " Кол.мест" ActiveSheet.Cells(q + 2, 14).Select Selection = " Нетто" ActiveSheet.Cells(q + 2, 15).Select Selection = " Брутто" Range(Cells(q + 2, 2), Cells(q + 2, 15)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.149998474074526 .PatternTintAndShade = 0 End With Selection.Font.Bold = False Selection.Font.Bold = True With Selection .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With w = q + 3 Windows(" мери.xlsx").Activate
Windows(" Книга2.xlsx").Activate
For i = 12 To q ActiveSheet.Cells(i, 2).Select art = Selection e = 0 For iq = q + 1 To q + 100 ActiveSheet.Cells(iq, 2).Select qwt = Selection If qwt = art Then e = 1 Next Do While e = 0 For ii = 12 To q ActiveSheet.Cells(ii, 2).Select svl = Selection
ActiveSheet.Cells(ii, 4).Select cntr = Selection ActiveSheet.Cells(ii, 8).Select eeeee = Selection
ActiveSheet.Cells(ii, 10).Select eeee = Selection ActiveSheet.Cells(ii, 11).Select eee = Selection ActiveSheet.Cells(ii, 12).Select qq = Selection ActiveSheet.Cells(ii, 13).Select qqq = Selection
ActiveSheet.Cells(ii, 14).Select qqqq = Selection
ActiveSheet.Cells(ii, 15).Select qqqqq = Selection
Do While svl = art
ActiveSheet.Cells(w, 2).Select Selection = art
ActiveSheet.Cells(w, 4).Select Selection = cntr
ActiveSheet.Cells(w, 8).Select Selection = eeeee + Selection
ActiveSheet.Cells(w, 10).Select Selection = eeee + Selection ActiveSheet.Cells(w, 11).Select Selection = eee + Selection
ActiveSheet.Cells(w, 12).Select Selection = qq + Selection qeqe = 0 ActiveSheet.Cells(w, 13).Select Selection = qqq + Selection If qqq = " NO INFO" Then Selection = " N/A": qeqe = 1 ActiveSheet.Cells(w, 14).Select Selection = qqqq + Selection
ActiveSheet.Cells(w, 15).Select Selection = qqqqq + Selection Exit Do Loop Next w = w + 1
Exit Do Loop Next
e = 0 For w = 12 To q ActiveSheet.Cells(w, 15).Select qqq = qqq + Selection ActiveSheet.Cells(w, 14).Select qqqq = qqqq + Selection ActiveSheet.Cells(w, 13).Select qqqqq = qqqqq + Selection ActiveSheet.Cells(w, 12).Select qqqqqq = qqqqqq + Selection ActiveSheet.Cells(w, 11).Select qqqqqqqq = qqqqqqqq + Selection ActiveSheet.Cells(w, 10).Select e = e + Selection ActiveSheet.Cells(w, 9).Select qe = qe + Selection ActiveSheet.Cells(w, 8).Select qqe = qqe + Selection Next ActiveSheet.Cells(q, 15).Select Selection = qqq ActiveSheet.Cells(q, 14).Select Selection = qqqq ActiveSheet.Cells(q, 13).Select Selection = qqqqq ActiveSheet.Cells(q, 12).Select Selection = qqqqqq ActiveSheet.Cells(q, 11).Select Selection = qqqqqqqq ActiveSheet.Cells(q, 10).Select Selection = e ActiveSheet.Cells(q, 9).Select Selection = qe ActiveSheet.Cells(q, 8).Select Selection = qqe
Windows(" Книга2.xlsx").Activate For i = q + 2 To q + 1000 Cells(i, 2).Select ee = Selection If ee = " " Then q = i: Exit For Next
ActiveSheet.Cells(q + 1, 2).Select
Selection = " Группировка по до1" Range(Cells(q + 1, 2), Cells(q + 1, 2)).Select With Selection.Font .Name = " Calibri" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ThemeColor = xlThemeColorLight1 .TintAndShade = 0 .ThemeFont = xlThemeFontMinor End With Selection.Font.Bold = True ActiveSheet.Cells(q + 2, 2).Select Selection = " Код ТНВЭД(4 знака)" ActiveSheet.Cells(q + 2, 3).Select Selection = " Кол-во" ActiveSheet.Cells(q + 2, 4).Select Selection = " Стоимость" ActiveSheet.Cells(q + 2, 5).Select Selection = " Фрахт" ActiveSheet.Cells(q + 2, 6).Select Selection = " Стоимость, Итого" ActiveSheet.Cells(q + 2, 7).Select Selection = " Кол.мест" ActiveSheet.Cells(q + 2, 8).Select Selection = " Нетто" ActiveSheet.Cells(q + 2, 9).Select Selection = " Брутто" Range(Cells(q + 2, 2), Cells(q + 2, 15)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.149998474074526 .PatternTintAndShade = 0 End With Selection.Font.Bold = False Selection.Font.Bold = True With Selection .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With w = q + 3 Windows(" мери.xlsx").Activate
Windows(" Книга2.xlsx").Activate
For i = 12 To q ActiveSheet.Cells(i, 2).Select art = Left(Selection, 4) e = 0 For iq = q + 1 To q + 100 ActiveSheet.Cells(iq, 2).Select qwt = Left(Selection, 4) If qwt = art Then e = 1 Next Do While e = 0 For ii = 12 To q ActiveSheet.Cells(ii, 2).Select svl = Selection
ActiveSheet.Cells(ii, 4).Select cntr = Selection ActiveSheet.Cells(ii, 8).Select eeeee = Selection ActiveSheet.Cells(ii, 10).Select eeee = Selection ActiveSheet.Cells(ii, 11).Select eee = Selection ActiveSheet.Cells(ii, 12).Select qq = Selection ActiveSheet.Cells(ii, 13).Select qqq = Selection
ActiveSheet.Cells(ii, 14).Select qqqq = Selection ActiveSheet.Cells(ii, 15).Select qqqqq = Selection
Do While Left(svl, 4) = art
ActiveSheet.Cells(w, 2).Select Selection = art
ActiveSheet.Cells(w, 3).Select Selection = eeeee + Selection
ActiveSheet.Cells(w, 4).Select Selection = eeee + Selection ActiveSheet.Cells(w, 5).Select Selection = eee + Selection
ActiveSheet.Cells(w, 6).Select Selection = qq + Selection qeqe = 0
ActiveSheet.Cells(w, 7).Select Selection = qqq + Selection If qqq = " NO INFO" Then Selection = " N/A": qeqe = 1 ActiveSheet.Cells(w, 8).Select Selection = qqqq + Selection
ActiveSheet.Cells(w, 9).Select Selection = qqqqq + Selection Exit Do Loop Next w = w + 1
Exit Do Loop Next
End Sub
Sub арт()
Windows(" ARTIKUL1.xlsx").Activate
Range(" B514").Select End Sub Sub возврат()
Windows(" спец.xlsm").Activate End Sub Sub Mr_Wolf() MsgBox (" Приветствую. Я - мистер Вульф, мое занятие - решение чужих проблем. На данный момент я попытаюсь решить проблему с неправильными значениями веса в спецификации.") MsgBox (" Что, файл в котором находится вес называется по другому? Отлично. Называйте его как вам вздумается.") MsgBox (" Так вот. Проблема может быть решена двумя методами.") eq = 1 Do While eq = 1 ee = MsgBox(" 1 метод. Я разбираюсь с проблемой сам. в таком случае нажимайте на ОК", vbOKCancel) If ee = vbOK Then eq = 3
Do While ee < > vbOK
ee = MsgBox(" 2 метод. Вы можите задать точный процент разницы между весами. Нажимайте на ОК и введите его в следующее окно.", vbOKCancel) qq = InputBox(" Разница в процентах.% писать не нужно.")
If ee = vbOK Then eq = 2 Exit Do Loop
Loop For i = 12 To 200 ActiveSheet.Cells(i, 15).Select e = Selection If e = " " Then Exit For Next
For ii = 12 To i - 2 ActiveSheet.Cells(ii, 15).Select e = Selection ActiveSheet.Cells(ii, 14).Select If eq = 3 Then Selection = e * (0.95 - Rnd() / 5): eqq = eqq + Selection If eq = 2 Then Selection = e * (1 - qq / 100): eqq = eqq + Selection Next ActiveSheet.Cells(i - 1, 14).Select Selection = eqq MsgBox (" Думаете мистер Вульф забыл о группировке по кодам? ") MsgBox (" Ничего подобного") w = i + 2 For iq = i + 2 To i + 100
ActiveSheet.Cells(iq, 14).Select If Selection = " " Then Exit For Selection = 0 ActiveSheet.Cells(iq, 2).Select Selection = 0
Next For iii = 12 To i - 1 ActiveSheet.Cells(iii, 2).Select art = Selection e = 0 For iq = i + 1 To i + 100 ActiveSheet.Cells(iq, 2).Select
If Selection = " " Then Exit For qwt = Selection If qwt = art Then e = 1 Next Do While e = 0 For ii = 12 To i ActiveSheet.Cells(ii, 2).Select svl = Selection ActiveSheet.Cells(ii, 14).Select qqqq = Selection
Do While svl = art
ActiveSheet.Cells(w, 2).Select Selection = art
ActiveSheet.Cells(w, 14).Select Selection = qqqq + Selection
Exit Do Loop Next w = w + 1 Exit Do Loop Next
End Sub Sub home() ' home Макрос Windows(" ARTIKUL1.xlsx").Activate ActiveWindow.Close Windows(" мери.xlsx").Activate ActiveWindow.Close Windows(" Книга2.xlsx").Activate ActiveWindow.Close End Sub
|