同工作表按条件提取数据

weilaikeqiak

根据N列数据对应右边O列的号位，如果等于0就把与之对应的N列数据提取到D列，依次往下填充，请较大师们。

limonet

你是M365，直接用函数。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.8.7
   
2.     r = Cells(Rows.Count, "n").End(3).Row
   
3.     arr = [n1].Resize(r, 2)
   
4.     ReDim brr(1 To r, 1 To 1)
   
5.     For i = 2 To UBound(arr)
   
6.         If arr(i, 2) = 0 Then
   
7.             m = m + 1
   
8.             brr(m, 1) = arr(i, 1)
   
9.         End If
   
10.     Next
    
11.     r = Cells(Rows.Count, "d").End(3).Row
    
12.     Cells(r + 1, 4).Resize(m, 1) = brr
    
13.     MsgBox "OK！"
    
14. End Sub
    

复制代码

无关岁月

1. Sub test()
   
2. Dim r, arr, i, m
   
3. r = [d1].End(4).Row
   
4. arr = [n1].CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     If arr(i, 2) = 0 Then
   
7.         m = m + 1
   
8.         Cells(r + m, 4) = arr(i, 1)
   
9.     End If
   
10. Next
    
11. End Sub
    

复制代码

lsc900707

参考测试附件：

Qs18

Sub qs()
Dim arr, i
With Sheet1
    arr = .Range("n1").CurrentRegion.Value
    ReDim brr(1 To UBound(arr), 1 To 1)
    For i = 2 To UBound(arr)
        If arr(i, 2) = 0 Then
            m = m + 1
            brr(m, 1) = arr(i, 1)
        End If
    Next
  .Range("d" & .Cells(Rows.Count, "d").End(3).Row + 1).Resize(m) = brr
End With
End Sub

Qs18

试试.............

Qs18

试试.............

zhangcheng6688

学习一下数组，打扰了
Sub test()
arr = [n1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 2 To UBound(arr)
   If arr(i, 2) = 0 Then
      m = m + 1
      brr(m, 1) = arr(i, 1)
   End If
Next
lastr = Cells(Rows.Count, "d").End(xlUp).Row
Range("d" & (lastr + 1)).Resize(m, 1) = brr
End Sub