Отфильтруйте ненулевое значение в ячейке и скопируйте значения в отдельные столбцы / лист для больших данных

Question

Я пытаюсь скопировать только значения, отличные от нуля, на отдельном листе / столбце. Это необходимо сделать для больших данных.

Я пробовал приведенный ниже код vba-excel, но застрял в цикле for. Обратите внимание, что диапазон в приведенном ниже коде указан, но в большом наборе данных он неизвестен, поэтому ему нужно найти все строки до конца.

Sub test()
    Dim Lastrow As Long, i As Long
    Dim reportsheet As Worksheet
    Dim datasheet As Worksheet
    'LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

    Set datasheet = Sheet1
    Set reportsheet = Sheet2

    datasheet.Select
    'finalrow = Cells(Rows.Count, 1).End(xlUp).Row


    'With ThisWorkbook.Worksheets("Sheet1")

    Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To Lastrow
        If Cells(i, 2).Value <> 0 Then
        'Rows(i).Delete
        Range(Cells(i, 1), Cells(i, 12)).Copy
        reportsheet.Select
        Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Next i
End Sub

Пример данных -

Ожидаются все значения в одном столбце без нулевого значения или #NA или пустых ячеек. Мне нужно построить график с этими данными. Любые предложения приветствуются. Спасибо.

Answer 1

Попробуй это. учитывая, что столбцы имеют только цифры.

Sub FilterZeros()
Dim i As Long, lr As Long, lc As Long
Dim sh1 As Worksheet, sh2 As Worksheet

Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")

'Last column
lc = Cells(1, Columns.Count).End(xlToLeft).Column

'Loops between column in Sheet1 to filter valus <>0
For i = 1 To lc
   sh1.Activate
   Range("A1").AutoFilter Field:=i, Criteria1:="<>0"
   n = Cells(Rows.Count, i).End(xlUp).Row
   Range(Cells(2, i), Cells(n, i)).SpecialCells(xlCellTypeVisible).Copy

  'find the last column and adds the copied data in Sheet2
  sh2.Activate
  lc2 = Cells(2, Columns.Count).End(xlToLeft).Column + 1
  Cells(2, lc2).PasteSpecial Paste:=xlValues
  sh1.Activate
  Range("A1").AutoFilter
Next


End Sub

Используйте ниже исправленный код без цикла, чтобы выбрать какой-либо конкретный столбец для фильтрации и копирования значений.

Sub FilterZeros()
Dim i As Long, lr As Long, lc As Long
Dim sh1 As Worksheet, sh2 As Worksheet

Set sh1 = ThisWorkbook.Worksheets("Sheet1")
Set sh2 = ThisWorkbook.Worksheets("Sheet2")

'First Column to be filtered
   sh1.Activate
   i = "Enter your column no. 1 here"
   Range("A1").AutoFilter Field:=i, Criteria1:="<>0"
   n = Cells(Rows.Count, i).End(xlUp).Row
   Range(Cells(2, i), Cells(n, i)).SpecialCells(xlCellTypeVisible).Copy

  sh2.Activate
  Range("A2").PasteSpecial xlPasteValues

'Second Column to be filtered
  sh1.Activate
  Range("A1").AutoFilter
  i = "Enter your column no. 2 here"
  Range("A1").AutoFilter Field:=i, Criteria1:="<>0"
  n = Cells(Rows.Count, i).End(xlUp).Row
   Range(Cells(2, i), Cells(n, i)).SpecialCells(xlCellTypeVisible).Copy

  sh2.Activate
  Range("B2").PasteSpecial xlPasteValues

  sh1.Activate
  Range("A1").AutoFilter

  sh2.Activate
  Range("A2").Select

End Sub

Спасибо, Хафиз