Вот, сам код как выглядит, подчеркнуты места, где находится переменная.
Option Compare Text
Dim myTMes ---ВОТ ЗДЕСЬ, ВНАЧАЛЕ Я ОБЪЯВИЛ ТЕМУ, КАК ОСИЛИЛ В ИНЕТЕ ,
=========================================================================
'В этом модуле происходит определение первой ячейки(вид инвойса) с кодом тнвед(макрос);
' все виды товаров здесь есть.Отсюда начинаем искать уже определенный вид товара и объяединять инвойсы по етоим признакам
'на каждый вид будет свой модуль, чтоби не путаться.
Sub ВидИнвойса(control As Office.IRibbonControl)
Dim spec As Variant
' ' проверяем на наличие тестеров:
' Set spec = ActiveSheet.Cells.Find(what:="Тестеры", LookAt:=xlPart, MatchCase:=False)
' If Not spec Is Nothing Then
' Application.ScreenUpdating = False
' AA_Nad_ModuleSformi_A_Testera.LoopFilesTestera
' End If
Call ВидИнвойс
End Sub
Sub ВидИнвойс()
Dim KodVd As Variant
Dim sh_res As Worksheet
Dim Nachalo As Integer, lngKonec As Integer
Dim myF As Range
Dim myF2 As Range ' это для игрушек, у них нет столбца с ящиками
Dim spec As Variant
Set sh_res = ActiveSheet
' Откл. монитора.
Application.ScreenUpdating = False
' отслеживаем столбец с названием, если не в столбце D, то добовляем-скрываем один столбец:
Set myF = sh_res.Columns("D").Find("Код ТН ВЭД", , , xlPart)
If myF Is Nothing Then
sh_res.Columns("C").Insert
sh_res.Columns("C").Hidden = True
End If
'Cells(Columns(4).Find("Код ТН ВЭД").row + 2, Columns(4).Find("Код ТН ВЭД").Column).Select
'определяем первую ячейку с кодом тнвед:
' если на листе встречается слово тетсрры, то ето тестеры))):
Set spec = ActiveSheet.Cells.Find(what:="Тестеры", LookAt:=xlPart, MatchCase:=False)
If Not spec Is Nothing Then
AA_Nad_ModuleSformi_A_Testera.LoopFilesTestera
End If
KodVd = Cells(Columns(4).Find("Код ТН ВЭД*").row + 2, Columns(4).Find("Код ТН ВЭД*").Column).Value
Select Case KodVd
' 1)Алкоголь(вообще с воды начанием):
Case 2202100000# To 2208909900#
'MsgBox "это пойло!"
' ищем алкогольные инвойсы:
Call AA_Nad_ModuleSformi_A_Alko.LoopFilesAlko
' 2)Сигареты:+ Стики:
Case 2402209000#
'MsgBox "это сигареты!"
AA_Nad_ModuleSformi_A_Sigi.LoopFilesSigi
' 2а)+ Стики:
Case 2403999009#
'MsgBox "это стики!"
AA_Nad_ModuleSformi_A_Stiki.LoopFilesStiki
' 3)Шоколадки (под шоколадками подразумеваются разные товары, а не только шоколад):
Case "0701100000" To "2106108000", 9500000000# To 9503999999#
' для игрушек смотрим столбци, если не хватает, то добовляем:
Set myF2 = sh_res.Columns("H").Find("кол-во", , , xlPart)
If myF2 Is Nothing Then
sh_res.Columns("F").Insert
sh_res.Columns("F").ColumnWidth = 9.29
' sh_res.Columns("F").Hidden = True
sh_res.Columns("F").Insert
sh_res.Columns("F").ColumnWidth = 9.29
' sh_res.Columns("F").Hidden = True
'заполняем названия столбцов:
Nachalo = НачалоДанных
lngKonec = КонецДанных
With Range(Cells(Nachalo - 2, "F"), Cells(Nachalo - 2, "F"))
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
'.Interior.Color = 14994616
.Value = "кол-во" & Chr(10) & "в коробке"
End With
With Range(Cells(Nachalo - 2, "G"), Cells(Nachalo - 2, "G"))
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlMedium
'.Interior.Color = 14994616
.Value = "кол-во коробок"
End With
mesta
End If
'MsgBox "это шоколадки!"
AA_Nad_ModuleSformi_A_Shok.LoopFilesShok
' 4)Парфюм(вполть до мыла):
Case 3302909000# To 3408900000#
'MsgBox "это порфюм!"
AA_Nad_ModuleSformi_A_Parff.LoopFilesParff
'5) Бижутерия:(от сумочек до прочих, маникюрный комлект=8214200000; зонт=6601910000; очки = 90 04 101000 to 90 04 909000
' зеркала=7009920000# ; кольца-кулоны=7117900000+ часи двух видов!
Case 4202210000# To 4205009000#, 8214200000#, 6601910000#, 9004101000# To 9004909000#, 7009920000#, 7117900000#
AA_Nad_ModuleSformi_A_Bijj.LoopFilesBijj
'6)ЧАСЫ(ОНИ КАК БИЖУТЕРИЯ ТОКЛЬКО ОТДЕЛЬНО ДЯДЯ НАДОБЛЯ):
Case 9102110000#, 9102120000#
AA_Nad_ModuleSformi_A_Watches.LoopFilesWatches
' 7)СИГАРЫ(ОНИ КАК БИЖУТЕРИЯ ТОКЛЬКО ОТДЕЛЬНО ДЯДЯ НАДОБЛЯ):
Case 2402100000#
AA_Nad_ModuleSformi_A_Sigari.LoopFilesSigari
Case Else
MsgBox "я не знаю, чё ет за код такой(!"
End Select
End Sub
'запоминаем количество мест в переменную myTMest :
Sub mesta()
Dim myFMest As Range
Dim myTMest As Range
Dim shFrom As Worksheet, thisB As Workbook
Set shFrom = ActiveSheet
Set thisB = ActiveWorkbook
Dim shTo As Worksheet
Dim wbTo As Workbook
Dim Wb As Workbook
Dim myF As Range
Dim stype As String
Set myTMest = Cells.Find("Кол-во мест", , , xlPart)
myTMes = myTMest.Offset(0, 3).Value ================== ВОТ ЭТА ПЕРЕМЕННАЯ, В ЭТОМ МОДУЛЕ ВСЁ НОРМАЛЬНО
============================================================================================================
' End If
End Sub
ВОТ СЛЕДУЮЩАЯ ПРОЦЕДУРА, КУДА НУЖНЫ ДАННЫЕ ИЗ ПЕРЕМЕННОЙ ЭТОЙ:
Option Explicit
Dim myTMes - Я ЗДЕСЬ ТОЖЕ В НАЧАЛЕ ОБЪЯВИЛ, НО НИФИГА ЧЁТА((
==================================================================
' Вкладка "Шоколадки" - группа "Шоколадки" - "Сумма".
' Макрос работает с активным листом.
' Макрос обрабатывает лист после макроса "Сортировка".
' Вставка формул под каждым товаром.
'Sub Main(myControl As Office.IRibbonControl)- откзаываемся от кнопки
Sub ChockSumm()
Dim shAct As Excel.Worksheet, tbl As Excel.Range
Dim arrB() As Variant, cn As New Collection
Dim lngHRow As Long, lngLRow As Long
Dim i As Long, r As Long
Dim k As Long
Dim Nachalo As Integer, lngKonec As Integer
Dim rCell As Range, spec As Variant, specF As Variant
' Поиск первой и последней строки.
Nachalo = НачалоДанных
lngKonec = КонецДанных
'1. VBA-наименование активного листаи присвоение имени
Set shAct = ActiveSheet
If shAct Is Nothing Then
Exit Sub
End If
'2. Отключение монитора.
' Application.ScreenUpdating = False
'3. Поиск шапки и низа таблицы.
Call S_Hr.Function2(shAct, lngHRow, lngLRow)
'4. Vba-именование таблицы.
' В таблицу включается строка, которая находится под таблицей.
Set tbl = shAct.Rows(lngHRow & ":" & lngLRow + 1)
'5.
' Копирование столбца B в массив "arrB".
' Подготовка данных к сравнению.
arrB() = tbl.Columns("B").Value
For i = 2 To UBound(arrB, 1) Step 1
arrB(i, 1) = CStr(arrB(i, 1))
Next i
'6. Запись номеров пустых строк в коллекцию.
' Во вторую строку формула не вставляется, но эта строка нужна
' для составления формулы под первым товаром.
For i = 2 To UBound(arrB, 1) Step 1
If arrB(i, 1) = "" Then
cn.Add Item:=i
End If
Next i
'7. Вставка формул.
' В коллекции находятся два вида пустых строк:
'1) строки-заголовки групп;
'2) строки, которые находятся под товарами.
' В коллекции первая пустая строка - это строка-заголовок. В неё не надо вставлять формулы.
For i = 2 To cn.count Step 1
' Запись порядкового номера эксель-строки в переменную для удобства.
r = cn(i)
' Пустые строки-заголовки пропускаем.
' Они определяются по двум подрядстоящим пустым строкам.
If arrB(r - 1, 1) <> "" Then
Stop
' Вставка формул.
tbl.Range("J" & r).Resize(1, 2).FormulaR1C1 = "=SUM(R[-" & r - cn(i - 1) - 1 & "]C:R[-1]C)"
If tbl.Range("J" & r) = 0 Then
tbl.Range("J" & r) = myTMes - ПУСТО, ВООБЩЕ НИЧЕГО НЕ ПЕРЕДАЁТ СЮДА
============================ =========================================
End If
|
