满足一个条件则提取对应列的值

eyesonme22 · 发表于 2017-4-7 22:07

当“表2”中U5列>0所对应“表2”中A5列值，提取至“表3”A5列。
需用VB完成。

smdlyb · 发表于 2017-4-8 09:37

Sub yy()
ar = Sheets("表2").UsedRange
ReDim br(1 To UBound(ar), 1 To 1)
For i = 5 To UBound(ar)
      If ar(i, 21) > 0 Then
         n = n + 1
         br(n, 1) = ar(i, 1)
      End If
Next i
With Sheets("表3")
      .Range("a5:a" & [a65536].End(xlUp).Row).Clear
      .Range("a5").Resize(n) = br
End With
End Sub

lsc900707 · 发表于 2017-4-8 11:39

本帖最后由 lsc900707 于 2017-4-8 11:42 编辑

这边有很多这样的条件查询实例：
见证成长历程---2017年我的答疑解难代码汇总
http://club.excelhome.net/thread-1322460-1-1.html
(出处: ExcelHome技术论坛)

Sub lsc()
Range("a5:a" & Cells(Rows.Count, 1).End(3).Row) = ""
arr = Sheet4.[A1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 5 To UBound(arr)
If arr(i, 21) > 0 Then k = k + 1: brr(k, 1) = arr(i, 1)
Next
[A5].Resize(k) = brr
End Sub

复制代码

eyesonme22 · 发表于 2017-4-8 12:40

smdlyb 发表于 2017-4-8 09:37
Sub yy()
ar = Sheets("表2").UsedRange
ReDim br(1 To UBound(ar), 1 To 1)

现在这个是模块，请问怎么写可以放到sheet表中。

eyesonme22 · 发表于 2017-4-8 12:41

lsc900707 发表于 2017-4-8 11:39
这边有很多这样的条件查询实例：
见证成长历程---2017年我的答疑解难代码汇总
http://club.excelhome.net ...

现在这个是模块，请问怎么写可以放到sheet表中。

lsc900707 · 发表于 2017-4-8 12:47

本帖最后由 lsc900707 于 2017-4-8 12:48 编辑

eyesonme22 发表于 2017-4-8 12:41
现在这个是模块，请问怎么写可以放到sheet表中。

插入模块呀，把代码复制到模块中，按钮在表3，连接宏就好了。

smdlyb · 发表于 2017-4-8 12:49

eyesonme22 发表于 2017-4-8 12:40
现在这个是模块，请问怎么写可以放到sheet表中。

放在表中什么意思？？是想自动执行？？

lsc900707 · 发表于 2017-4-8 12:56

本帖最后由 lsc900707 于 2017-4-8 12:58 编辑

eyesonme22 发表于 2017-4-8 12:41
现在这个是模块，请问怎么写可以放到sheet表中。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column = 1 And Target.Row >= 5 Then
      Range("a5:a" & Cells(Rows.Count, 1).End(3).Row) = ""
      arr = Sheet4.[A1].CurrentRegion
      ReDim brr(1 To UBound(arr), 1 To 1)
      For i = 5 To UBound(arr)
         If arr(i, 21) > 0 Then k = k + 1: brr(k, 1) = arr(i, 1)
      Next
      [A5].Resize(k) = brr
   End If
End Sub

eyesonme22 · 发表于 2017-4-8 13:29

smdlyb 发表于 2017-4-8 12:49
放在表中什么意思？？是想自动执行？？

http://club.excelhome.net/thread-1339038-1-1.html能帮我看看这个贴吗，谢谢

eyesonme22 · 发表于 2017-4-8 13:31

lsc900707 发表于 2017-4-8 12:56
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 And Target ...

http://club.excelhome.net/thread-1339038-1-1.html能帮我看看这个贴吗？谢谢

		自动登录	找回密码
密码			免费注册

[求助] 满足一个条件则提取对应列的值

评分

评分