过滤单元格中的非零值，并在单独的列/表中复制值以获取大数据

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

谢谢， 哈菲兹