[已解决]如何快速查找目标组数据？

dfshmzdf

如附件 快速查找目标组数据附件.rar (22.64 KB, 下载次数: 21)

2012-9-19 22:58 上传

点击文件名下载附件    （07版）

谢谢！

最佳答案

月排行榜 / 总排行榜

风化石

2012-9-20 09:59

Sub Macro2()
Application.ScreenUpdating = False  '禁用刷新
Range("B4:D270").ClearContents
Sheets("Sheet1").Select
a = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Row  '行
b = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Column  '列
    m = 1
    f = Application.CountIf(Range(Cells(1, 1), Cells(a, b)), Sheets("sheet2").[B3].Value)
    For r = 1 To f
   Cells.Find(What:=Sheets("sheet2").[B3].Value, After:=ActiveCell).Activate
    x = ActiveCell.Row
    y = ActiveCell.Column
   If Cells(x, y + 1) = Sheets("sheet2").[C3] And Cells(x, y + 2) = Sheets("sheet2").[D3] Then
   
    z = Replace(Mid(Cells(x, y).Address, 2, 2), "$", "")    ' 由列数得到列标
    s = Replace(Mid(Cells(x, y + 1).Address, 2, 2), "$", "")
    t = Replace(Mid(Cells(x, y + 2).Address, 2, 2), "$", "")
   Sheets("sheet2").Cells(m + 3, 2).Resize(1, 3) = Array(z, s, t)
    m = m + 1
    End If
    Next
'----提示
If m = 1 Then
MsgBox "对不起，没找到", , "山风提示"
Else
MsgBox "共找到" & m - 1 & "组数据", , "山风提示"
End If
Sheets("Sheet2").Select
End Sub
副本Xl0000002.rar (11.91 KB, 下载次数: 30)

2012-9-20 09:58 上传

点击文件名下载附件

跳转到最佳答案楼层

hwc2ycy

用match可以找到所在列的列标号（用数字表示的）。

在V里可以通过查找到数据所在的单元格，然后取地址，再从地址值里返回所在的列字母表示。

风化石

Sub Macro2()
Application.ScreenUpdating = False  '禁用刷新
Range("B4:D270").ClearContents
Sheets("Sheet1").Select
a = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Row  '行
b = ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Column  '列
    m = 1
    f = Application.CountIf(Range(Cells(1, 1), Cells(a, b)), Sheets("sheet2").[B3].Value)
    For r = 1 To f
   Cells.Find(What:=Sheets("sheet2").[B3].Value, After:=ActiveCell).Activate
    x = ActiveCell.Row
    y = ActiveCell.Column
   If Cells(x, y + 1) = Sheets("sheet2").[C3] And Cells(x, y + 2) = Sheets("sheet2").[D3] Then
   
    z = Replace(Mid(Cells(x, y).Address, 2, 2), "$", "")    ' 由列数得到列标
    s = Replace(Mid(Cells(x, y + 1).Address, 2, 2), "$", "")
    t = Replace(Mid(Cells(x, y + 2).Address, 2, 2), "$", "")
   Sheets("sheet2").Cells(m + 3, 2).Resize(1, 3) = Array(z, s, t)
    m = m + 1
    End If
    Next
'----提示
If m = 1 Then
MsgBox "对不起，没找到", , "山风提示"
Else
MsgBox "共找到" & m - 1 & "组数据", , "山风提示"
End If
Sheets("Sheet2").Select
End Sub
副本Xl0000002.rar (11.91 KB, 下载次数: 30)

2012-9-20 09:58 上传

点击文件名下载附件

hyqzzs

学习了，感谢分享