Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Передача данных переменной из одной процедуры в другую, В первом макросе переменная myTMes нормально возвращает значение. А дальше ничего..
 
Код
Вот, сам код как выглядит, подчеркнуты места, где находится переменная.




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
поиск в видимых ячейках\строках, сейчас макрос возвращает данные в скрытых строках, - они не нужны.
 
Ищется часть слова от "контракта":
Код
contract = Cells.Find("*контра*").Offset(0, 1).Select
как сделать поиск только по видимому диапазону листа? спасибо.
Активировать лист рабочей книги из списка, из трёх вариантов
 
А можно сделать сразу список, типо: spisok = Array("Апсны", "Флагман", "разбивки")... и если из списка найден лист- активировать его: .spisok.Select, сейчас использую вот такую конструкцию:
Код
Sub Tеек()
Dim sh As Worksheet

  For Each sh In ThisWorkbook.Worksheets      
        If LCase(sh.Name) Like "апсны" Then
        sh.Select
        End If
        If LCase(sh.Name) Like "флагман" Then
        sh.Select
        End If
        If LCase(sh.Name) Like "разбивки" Then
        sh.Select
        End If 
Next
End Sub
хотелось бы укоротить как-то код... есть мысли какие-то? спасибо. Названия листов будут только в одном экземпляре из списка.
Почему переменные с одинаковыми значениями не видят друг друга?, и выполнение кода пропускает их одинаковые значения, может из-за кавычек, возвращаемых одной из переменных?
 
фрагмент кода(там всё в надстройке работает, нужно очень долго выдергивать для примера, может так будет понятно?):

Код
  ' В столбец "S" нужно вставлять данные на основе словаря "dicDopi".
           If dicDopi.Exists(key:=CStr(tbl.Cells(lngRowIndex - 1, "D"))) = True Then
           If dicDopi.Item(key:=CStr(tbl.Cells(lngRowIndex - 1, "D"))) = "ДОП НУЖЕН" Then

         ' данные для пременной "a" беру отсюдова: 
           a = CStr(tbl.Cells(lngRowIndex - 1, "D").Value)    
                  
            For k = Nachalo To lngKonec Step 1
           ' данные для переменной   kODvD беру здесь:
             KodVd = Val(ActiveSheet.Cells(k, 4).Value)
           ' В ОПРЕДЕЛЕННЫЙ МОМЕНТ УСЛОВИЕ ВЫПОЛНЯЕТСЯ: 9004109100 = 9004109100, 
            If KodVd = a Then
             Cells(k, 19) = Cells(k, 11)
         ' но код не видит , что условие выполнено, а постоянно пререходит на енд иф:
            End If
            Next
переменная KodVd возвращает значение 9004109100: KodVd = 9004109100,см. на фото:
переменная "a" возвращает значение "9004109100":  а = "9004109100", см. на фото:
т.е. после
Код
If KodVd = a Then
должна выполнятся
Код
Cells(k, 19) = Cells(k, 11)
а этого не происходит(
может потому-что
9004109100 <> "9004109100"??
есть идеи какие нить? как исправить?
Изменено: Домкрат - 28 май 2020 15:34:03
Как циклом пройтись по файлам в папке в зависимости от их размера?
 
так вообще возможно делать?
Проблема в том, что когда циклом проходим-обрабатываем файлы, макрос с маленького начинает и в него большой загружает,- получается долго ждать приходиться, а если будет наоборот, то экономим время.
Может как-то обработать предварительно файлы, чтобы сортирнулись по размеру сами?? или что?
Изменено: Домкрат - 18 май 2020 21:12:41
Распознование в тексте латиницы и кириллицы
 
Здравствуйте, как на взгляд специалиста будет сделать лучше, вот фрагмент кода:
Код
'это первоначальный вариант, тут буква Т в  латинской расскладке:

' проверяем наличие буквы Т в инвойсе, если если есть- удоляем её:
       
    If InStr(1, CStr(var), "T", vbTextCompare) > 0 Then
    var = Left(var, Len(var) - 1)

'я добавил игнор ошибки On Error Resume Next и добавил условие Or с русской буквой Т:

    On Error Resume Next
    If InStr(1, CStr(var), "T", vbTextCompare) > 0 Or InStr(1, CStr(var), "Т", vbTextCompare) > 0 Then
    var = Left(var, Len(var) - 1) 




может существуют более лучшие варианты? Если да, то подскажите пожалуйста.
Изменено: Домкрат - 13 май 2020 15:47:21
Почему переменная теряет свое значение?
 
сам код большой, пременная contract строка 18 , когда дело доходит до 92 строки - обнуляется. Что можно с этим сделать, чтобы значение оставалось?
в 92 строке два варианта существует для активации листа по имени... кто хелпнет?
Код
Sub LoopFilesAlko22()
    Dim myFSO As Object, myFolder As Object, myFile As Object
    Dim sh_act As Worksheet, rng_res As Range, res()
    Dim bk As Workbook, Sh As Worksheet
    Dim arr(), r As Long, i As Long, j As Long
    Dim ИМЯКНИГИ As String
    Dim ИМЯЭТОЙКНИГИ As String
    Dim KodV As Variant
    Dim myF As Range
    Dim shFroml As Worksheet
  ИМЯЭТОЙКНИГИ = ActiveWorkbook.name ' ЭТО Я ТЕСТИРУЮ.
  a = Cells.Find("*контра*").Offset(0, 1).Address
  Range(a) = LTrim(RTrim((Range(a))))
 
' ВОТ ЭТА ПЕРЕМЕННАЯ "contract" , КОГДА ДЕЛО ДОХОДИТ ДО 92 строки: If LCase(myFile.name) Like "LT_*" Then
   Set contract = Cells.Find("*контра*").Offset(0, 1) ' объявляем контракт, со здвигом сразу правее на одну ячейку

    ' Откл. монитора.
    Application.DisplayAlerts = False
    
    '3. Создание объекта для работы с папками и файлами.
    Set myFSO = CreateObject(Class:="Scripting.FileSystemObject")
    
    '4. Создание ссылки на папку, в которой находятся инвойсы.
        ' Путь определяется по активному файлу.
    Set myFolder = myFSO.GetFolder(ActiveWorkbook.Path)
    
    '5. Проверка, что нужные файлы не открыты, чтобы не было непредвиденных ситуаций.
        ' Открытым будет только один инвойс, который будет активным.
    For Each myFile In myFolder.Files
        For Each bk In Workbooks
            If bk.FullName <> ActiveWorkbook.FullName Then
                If bk.name = myFile.name Then
                    Application.ScreenUpdating = True
                    MsgBox "Закройте файлы, которые находятся в новой папке." & vbCr & _
                        "Открытым должен быть только один инвойс из новой папки.", vbExclamation
                    Exit Sub
                End If
            End If
        Next bk
    Next myFile
    
'---------------------------------------------------------------------------------------------------------------------
    '6. Сбор информации.
        ' Если в каком-то иновойсе в "G3" не пусто, значит макрос нужно остановить,
        ' т.к. работа уже была сделана.
     ' =========================================================================================
     ' ПОВТОР ПО-НОВОЙ
    '3) Извлечение данных из закрытых инвойсов.
    For Each myFile In myFolder.Files
     ИМЯКНИГИ = ActiveWorkbook.name
     ActiveWorkbook.Save
     
        ' Активный файл пропускаем.
        If myFile.name = ActiveWorkbook.name Then
      
             ' Следующий инвойс.
            
            GoTo metka_NextFile
            
        End If
        
        ' Скрытые файлы пропускаем.
        If (GetAttr(myFile.Path) And vbHidden) <> 0 Then
            GoTo metka_NextFile
        End If
            
        ' Смотрим расширение.
        If Not LCase(myFile.name) Like "*.xls*" Then
            GoTo metka_NextFile
        End If
        ' Смотрим спецификацию.
        If LCase(myFile.name) Like "*specifikacija*" Then
         GoTo metka_NextFile
        End If
        'определяем еслить ли лист в книге, если нет,- следующий файл:
         d = "инвойс"
         On Error Resume Next
         Set wsSheet = Sheets(d)
         If Err.number <> 0 Then
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If
        ' Определяем с каким листом будем работать: отказ: итак буду на етом листе находится!
        'If ActiveSheet.name = "спецификация" Then  только эту строчку коментим,- ниже влияет на всё!
        '========================================================================================
        ' походу из=за этого момента пременная contract теряет свое значание
         If LCase(myFile.name) Like "LT_*" Then
           Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("инвойс")
           Else
         Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("спецификация")
         End If
         '========================================================================================
        
        
'         If ActiveWorkbook.Sheets.count = 1 Then
'         Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("инвойс")
'         If ActiveWorkbook.Sheets.count > 1 Then
'          Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("спецификация")
'         d = "спецификация"
'         On Error Resume Next
'         Set wsSheet = Sheets(d)
'         If Err.number <> 0 Then
'         ActiveWindow.Close savechanges:=False
'         GoTo metka_NextFile
'         End If
           
           'End If
        Sh.Activate
         'определяем еслить ли лист в книге, если нет,- следующий файл:
         d = "инвойс"
         On Error Resume Next
         Set wsSheet = Sheets(d)
         If Err.number <> 0 Then
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If
        ' метка есть- пропускаем файл
        If ActiveSheet.Range("B5").Interior.Color = 16115929 Then
        GoTo metka_NextFile
        End If

        
        ' если метки нету,- , можно с файлом работать!
        If ActiveSheet.Range("B5").Interior.Color <> 16115929 Then
        'MsgBox "это он"
        ' ==========================================================================
        '        '========================================
        'тема контрактов: ПОКА НЕ ЗНАЮ КУДА СТВИТЬ ЭТУ 
        ' удоление лишних пробелов вначале и конце  контракта:
          b = Cells.Find("*контра*").Offset(0, 1).Address
          Range(b) = LTrim(RTrim((Range(b))))
          'определяем номер контракта нового инвойса
         Set contractt = Cells.Find("*контра*").Offset(0, 1) ' объявляем контракт, со здвигом сразу правее на одну ячейку
         ' проверяем контракты:
         If contract <> contractt Then 'если номера контрактов несовпадают, - пропускаем это файл
    

         MsgBox "эти контракты несопасдают:" & contract & contractt

        ' Stop
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If

'
'        '========================================
        
          Windows(ИМЯКНИГИ).Close savechanges:=True
          ' ЗАКРЫВАЕМ ВСЕ ОТКРЫТЫЕ КНИГИ, КРОМЕ АКТИВНОЙ.
          CloseAllWorkbooks_Save ' игоряшин макрос)))))
          
     
        End If

metka_NextFile:
    Next myFile
    Application.ScreenUpdating = True
  ' =========================================================================================
     ' КОНЕЦ ПОВТОРА ПО-НОВОЙ
' удоляем лишние листы в мастер-инвойсе, между активным листом и последним:
' в остальных видах товаров я сам макрос не буду копирувать, только запуск.
DeleteRightSheets
'metka_N:
End Sub
Изменено: Домкрат - 3 май 2020 20:19:20
Удалить из значения знака справа
 
что-то не могу найти похожих тем((, пример в файле прилагаю, может кто подскажет?
в столбце D находятся данные: числа и числа, выглядящие как текст, нужно в столбец AG вернуть эти данные с удаленными 4 знаками справа. МАКРОСОМ НУЖНО, Товарищи.
Изменено: Домкрат - 29 апр 2020 16:16:52
После обработки макросом в числовых значениях разделители точки меняются на запятые и нули пропадают, точки как разделитель у меня стоят специально.
 
Сам макрос выглядит так(файл с примером прилагаю):
Код
Sub Удалить_пробелы1()
 ' есть случаи перевода точек в запятые -- имей введу!
    Dim arr(), spl
    Dim lr As Long, lc As Long, I As Long, ii As Long, j As Long
   
    lr = Cells.Find(what:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).row
    lc = Cells.Find(what:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Column
    arr() = Range("a1").Resize(lr, lc).Value
    For I = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            spl = Split(arr(I, j), Chr(10))
            For ii = 0 To UBound(spl)
                spl(ii) = WorksheetFunction.Trim(spl(ii))
            Next ii
            arr(I, j) = Join(spl, Chr(10))
        Next j
    Next I
    Range("a1").Resize(lr, lc).Value = arr()
 
End Sub
в столбцах N:R находятся числа с разделителями точками, их Sub Удалить_пробелы1 и кромсает.
может кто подскажет как в коде поменять, чтобы точки не трогало оно?? меня хватило на "заплатку", обратная замена запятых на точки:
Код
Sub tочка()
'    '4. Замена запятой на точку.
        ActiveSheet.Columns("N:R").Replace what:=",", Replacement:=".", _
        LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

 
Как скопировать выделенный текст, чтобы через ctrl+V вставить в другую программу.
 
код макроса выглядит в таком виде:
Код
Sub CaSendKeys()
        Range("B10").Select
        Application.SendKeys "{F2}", True ' входим в ячейку
        Application.SendKeys "+{Home}", True   ' выделяем текст в ячейке
        'Application.SendKeys "^(C)", True - пробуем скопировать- не пашет ниразу(((((
      'как теперь скопировать-послать на клавиатуру  выделенныё текст?
        End Sub

Скрытый текст
Изменено: Домкрат - 25 апр 2020 23:06:07
Передача переменной в функцию
 
вот, переменная KodVd возвращает значение из ячейки:
Код
Private Function KodVd(KodVd As Variant)
    Dim KodVd As Variant
    
KodVd = Cells(Columns(4).Find("Код ТН ВЭД").row + 2, Columns(4).Find("Код ТН ВЭД").Column).Value

End Function

правильно ли написана эта фунцкия, и как в дальнейшем, в макросе передать значение из KodVd для использования в коде?
вот, как пример, я принудительно прописал ячейку d23 на переменную KodVd , она передает значение, и всё работает успешно всё:
Код
'определяем первую ячейку с кодом тнвед:
         KodVd = [d23]
'если вставить напрямую:
KodVd = Cells(Columns(4).Find("Код ТН ВЭД").row + 2, Columns(4).Find("Код ТН ВЭД").Column).Value)' выдаст ошибку: overflow
'то выдаст ошибку: overflow

         Select Case KodVd
 ' Алкоголь(вообще с воды начанием):
 Case 2202100000# To 2208909900#

пока сделал вот так, с учётом если будет пусто, с функцией походу прийдётся на потом оставить, а так всё работает именно так, как я себе предствляю исходя из местных условий:
Код
 'определяем первую ячейку с кодом тнвед:
         KodV = [d23]
         If KodV = "" Then
         KodV = [d24]
         End If
        Select Case KodV
 ' Алкоголь(вообще с воды начанием):
 Case 2202100000# To 2208909900#
Изменено: Домкрат - 20 янв 2020 04:07:44
Запускать каждый раз новую процедуру при прохождении цикла
 
Вкратце код выглядит во так:
макрос просматривает файлы в папке, смотрит данные в ячейке, в файлах, если данные верны, то должна запускаться каждый раз разная процедура из списка
Сформировать01
Сформировать02
        Сформировать03
        Сформировать04
        Сформировать05
по кругу:
Код
'3) Извлечение данных из закрытых инвойсов.
    For Each myFile In myFolder.Files
.....
 ' Алкоголь(вообще с воды начанием):
 Case 2202100000# To 2208909900#

         ' работа в инвойсе:
   ЗДЕСЬ НУЖЕН СЧЕТЧИК, ЧТОБЫ ПООЧЕРЕДИ ЗАПУСКАЛ НИЖЕУКАЗАННЫЕ ПРОЦЕДУРЫ.
         Сформировать01
         Сформировать02
         Сформировать03
         Сформировать04
         Сформировать05



' Закрытие инвойса.
        Sh.Parent.Close savechanges:=False
     Case Else
     Sh.Parent.Close savechanges:=False
    GoTo metka_NextFile
End Select
если пройден один цикл,- запускаем процедуру Сформировать01, если два цикла,- запускаем процедуру Сформировать02 и.т.д.
есть идеи какие-нить?  спасибо.
как с помощью цикла выделить вторую пустую ячейку, решение макросом без цикла есть в примере.
 
Хотелось бы найти способ с помощью цикла, начиная от D6 и желательно помимо второй пустой ячейки можно было выделить и третью..
Таблица-список над основной таблицей. Как найти последнюю строку вспомогательной таблицы?
 
В прилагаемом файле пример-описание проблемы. Есть идеи какие-нибудь? Не поделитесь?
Изменено: Домкрат - 10 янв 2020 13:59:59
вечером, после трудного дня, можно же послушать качественную музыку?
 
например, через активные Cantonы, как у меня,- качают достойно, нареканий нет...
Думаю пассивные + усилок брать,- ну такой гемар по сравнению с тем, что имею...
подойдёт-не подойдёт, внешний вид(и колонок и усилка тоже)... долгая и мутная тема, не знаю чем закончится, но пока радуюс, тем что имею)  
Преобразовать текстовые значения ячеек, которые могут интерпретироваться как числа и/или даты
 
чтобы его(форматирование) вернуть, нужно через F2 зайти в ячейку и тогда начинает опять работать. Нашел только такой момент:

Цитата
Application.SendKeys "{F2}", True
эта строка работает только с активной ячейкой, а вот как эту команду , чтобы работало по всему диапазону столбца D неосиливаю. Може кто поможе?
Анализ текста регулярными выражениями (RegExp), поиск по раскладке- русский алфавит не ищет, только принудительно, через |
 
По столбцу Е, в тексте вида Twin F10036 Lon.Skyl.Tin3x 100g ПО 100 ГР. нужно найти цифру(ы) любую, с пробелом или без, содержащую букву Xx в русской или английской раскладке(жирным подсветил), этот случай может быть или не может быть, в коде, в примере, эта строка выглядет так:
Код
objRegExp.Pattern = "(\S)(\d){1,2}( )?([Xx])\b|([Хх])|( )(\d){1,2}( )?([А-Яа-яXx])\b"

я принудительно и русскую раскладку поставил и английскую вот так, через ИЛИ:([Xx])\b|([Хх]), а можно как-то нормально сделать вида: [А-Яа-яA-Za-z]? т.е. упростить хочется код.
поставить пробел между текстом и цифрой с определённой буквой, в конце теста иногда встречаются прикреплённые цифры, их нужно отделить
 
формат текста такой:
Twin F10036 Lon.Skyl.Tin3x - красным покрасил нужный фрагмент для отделения, после цифры идет знак(буква): x, X, с пробелом или без. Есть идеи какие-нить?
Вывести список номеров товаров, где есть примечания, вывести список по отношению к нумерации товаров по столбцу G
 
Здравствуйте, уважаемый GRIM уже написал макрос такого вида, в нём выводиться список с нумерацией строк, а хотелось продолжить тему и сделать список по номерам товаров, в прилагаемом файле я расписал что-к -чему, прошу посодействовать в решении проблемы!
Код
Dim Nachalo As Long, lngKonec As Long
    Dim i As Long, x
    Nachalo = НачалоДанных
    lngKonec = КонецДанных
    On Error Resume Next
    For Each cell In Range(Cells(Nachalo - 1, "F"), Cells(lngKonec, "F"))
        If cell.Comment Is Nothing Then
        Else
            x = x & cell.row & ", "
        End If
    Next
    On Error Resume Next
    x = Left(x, Len(x) - 2)
    If x <> "" Then
    MsgBox "Есть проблемы по письмам, ТОВАРЫ № " & x
    Else
    MsgBox "По письмам замечаний нет!"
    End If
вывести в сообщении список номеров строк с примечаниями, сами примечания ищем по столбцу F
 
Здравствуйте, есть код, в него как-то можно добавить список строк, где могут быть примечания?:
Код
If Not Columns("F").Comment Is Nothing Then
   MsgBox "Ячейка содержит примечание  строки № & И ДАЛЕЕ НОМЕРА СТРОК"
Else
   MsgBox "Ячейка не содержит примечание"
End If

Спасибо.
Изменено: Домкрат - 16 окт 2019 12:20:26
Страницы: 1
Наверх