条件查找

luowangxx

各位大虾，附件文件查询中作溥中想根据输入的条件查找出所要的数据，数据在数据浦表中。
以上，谢谢！
工作簿1.rar (4.24 KB, 下载次数: 41)

2011-10-10 17:23 上传

点击文件名下载附件

luowangxx

有木有知道的？

luowangxx

有木有知道的，求解，亲们！

w2001pf

顶一下吧。

开辆小富康

给你一个我写的通用查询模块：
就象SQL一样，在EXCEL中执行，肯定比SQL要快啦。

Function FiltData(Arr, FiltArr)
  'filtarr,列号，筛选条件，例  2,50,">=",3,"abc","like"
  '当有符合条件的，返回已经转置后的数组，无符合的，返回空值
  Dim Bln As Boolean
  Dim i&
  Dim j%
  Dim n%
  Dim ArrRst(), K&
  Dim MyRst()
  Dim Tmp, Comp$, Col&
  
  For i = 1 To UBound(Arr)
     Bln = True
     For n = 1 To UBound(FiltArr) Step 3
         
         Col = FiltArr(n)
         Tmp = FiltArr(n + 1)
         Comp = FiltArr(n + 2)
         Select Case Comp
            Case "like"
                If Not LCase(Arr(i, Col)) Like "*" & LCase(Tmp) & "*" Then Bln = False: GoTo CompEnd
            Case "="
                If Not Arr(i, Col) = Tmp Then Bln = False: GoTo CompEnd
            Case ">="
                If Not Arr(i, Col) >= Tmp Then Bln = False: GoTo CompEnd
            Case "<="
                If Not Arr(i, Col) <= Tmp Then Bln = False: GoTo CompEnd
            Case ">"
                If Not Arr(i, Col) > Tmp Then Bln = False: GoTo CompEnd
            Case "<"
                If Not Arr(i, Col) < Tmp Then Bln = False: GoTo CompEnd
         End Select
     Next n
CompEnd:
     If Bln Then
        K = K + 1
        ReDim Preserve ArrRst(1 To UBound(Arr, 2), 1 To K)
        For j = 1 To UBound(Arr, 2)
          ArrRst(j, K) = Arr(i, j)
        Next j
     End If
  Next i
  
  If K > 0 Then '进行转置
     ReDim MyRst(1 To UBound(ArrRst, 2), 1 To UBound(ArrRst))
     For i = 1 To UBound(ArrRst, 2)
        For j = 1 To UBound(ArrRst)
           MyRst(i, j) = ArrRst(j, i)
        Next j
     Next i
     FiltData = MyRst
     
  End If
End Function

兰色幻想

条件是什么?哪个单元格里的是条件?

luowangxx

回复 兰色幻想 的帖子

条件是白色区域