Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Если в диапазоне не содержатся ненулевые значения, то после фильтрации диапазона от нулевых значений, макрос все равно копирует все нулевые значения
 
#1
28.04.2022 10:55:39
Уважаемые знатоки VBA, помогите пожалуйста найти ошибку в коде!
Во второй строке фильтрую диапазон по критерию "<> 0", причем пробовал двумя методами
1  Criteria1:="<>0", Operator:=xlFilterValues    
2  Criteria1:="<>0", Operator:=xlAnd  
В итоге т.к. Field 13 кроме нулей других значений не содержит, макрос нули не отфильтровывает, копирует весь столбец с нулевыми значениями и дальше макрос их вставляет в соответствии с инструкциями кода. Что это за беда?!

Код
ActiveSheet.ListObjects("Выгрузки_xml").Range.AutoFilter Field:=13, _
       Criteria1:="<>0", Operator:=xlFilterValues             ' фильтранули нули по 13 столбцу
    
    Set wb = GetObject("Наш_файл".xlsx")
    wb.Windows(1).Visible = True
    Workbooks.Open Filename:="Наш_файл".xlsx"
    Workbooks("Наш_файл".xlsx").Worksheets("Лист").Activate        
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      'сняли фильтры если они есть, если их нет обнулили автофильтр
    
    Windows("Отчет_xml.xlsm").Activate  ' Активировать нужную книгу (переключситься)
    Range("M2").Select
    Range(Selection, Selection.End(xlDown)).Select          ' выделили весь отфильтрованный столбец до конца
    Selection.Copy                                          ' скопировали содержимое
    
    Workbooks("Наш_файл".xlsx").Worksheets("Лист").Activate     
    Cells(Range("D4").End(xlDown).Row, [O1].Column).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False     'Спустились до конца столбце D (т.к. он отправная точка, т.к. всегда заполнен) и вставили теперь БПИФы в (M)
    Cells(Range("D4").End(xlDown).Row, [M1].Column).Offset(1, 0).Resize(Selection.Rows.Count).Value = 0                                                        'Вставляем 0 в столбец М(притоки)
    
 
 
 
#2
28.04.2022 11:09:43
Код
    'Selection.Copy                                          ' скопировали содержимое
     
    Dim arr As Variant
    For Each cl In Selection
        If Not cl.EntireRow.Hidden Then
            If IsEmpty(arr) Then
                ReDim arr(1 To 1)
            Else
                ReDim Preserve arr(1 To UBound(arr) + 1)
            End If
            arr(UBound(arr)) = cl.Value
        End If
    Next
    
    Workbooks("Наш_файл.xlsx").Worksheets("Лист").Activate
    Cells(Range("D4").End(xlDown).Row, [O1].Column).Offset(1, 0).Resize(UBound(arr)) = Applcation.Transpose(arr)                 '.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False     'Спустились до конца столбце D (т.к. он отправная точка, т.к. всегда заполнен) и вставили теперь БПИФы в (M)
 
 
 
#3
28.04.2022 15:35:54
Вот так сделал, все равно вставляет нулевые данные.
Код
 Range(Selection, Selection.End(xlDown)).Select          ' выделили весь отфильтрованный столбец до конца
    Selection.Copy
    
      
    Dim arr As Variant
    For Each cl In Selection
        If Not cl.EntireRow.Hidden Then
            If IsEmpty(arr) Then
                ReDim arr(1 To 1)
            Else
                ReDim Preserve arr(1 To UBound(arr) + 1)
            End If
            arr(UBound(arr)) = cl.Value
        End If
    Next
    
    Workbooks("Наш файл.xlsx").Worksheets("Наш файл").Activate         
    Cells(Range("D4").End(xlDown).Row, [O1].Column).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  
Изменено: Артем_81 - 28.04.2022 15:36:14
 
 
 
#4
28.04.2022 16:21:20
Ответ найдёте в своих комментариях сообщения #1 )
Код
' фильтранули нули по 13 столбцу
'сняли фильтры если они есть, если их нет обнулили автофильтр
' выделили весь отфильтрованный столбец до конца
' скопировали содержимое
 
 
 
#5
28.04.2022 17:49:20
Цитата
написал:
'сняли фильтры если они есть, если их нет обнулили автофильтр
Если вы эту строчку
Код
  If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData      'сняли фильтры если они есть, если их нет обнулили автофильтр

имеете в виду, то она относится к файлу в который вставляются данные, а у мне вопрос как отфильтровать в исходном файле данные от нулевых значений, или я что-то не правильно понял?
Изменено: Артем_81 - 28.04.2022 17:50:15
 
 
 
#6
29.04.2022 09:50:51
Ага, значит ошибка в другом месте. Неправильно скопировали
Код
Cells(Range("D4").End(xlDown).Row, [O1].Column).Offset(1, 0).Resize(UBound(arr)) = Application.Transpose(arr)
 
 
 
Страницы: 1
Наверх