求大神帮忙做个查询功能的表格

akk0415 · 发表于 2019-12-5 13:30

求论坛里的大神帮忙做一个查询功能的表格，万分感谢！本来想自己折腾折腾，可以效果都不理想。
例如在C2单元格输入760回车（或者点击按钮都行）后显示数据表里的760执手及760-1，760-2的所有信息

NadrsSaber · 发表于 2019-12-5 15:06

Sub 按钮1_Click()

Dim str$, cxrow!, num&
str = Sheet1.[C2]
cxrow = 5
num = 0

If Not IsEmpty(str) Then
      Dim arr, r&
      r = Sheet2.Range("A1").End(xlDown).Row
      arr = Sheet2.Range("A2:K" & r)
      For i = 1 To UBound(arr)
         If arr(i, 1) Like "*" & str & "*" Then
            num = num + 1
         End If
      Next
      Dim cxArr
      ReDim cxArr(1 To num, 1 To 11)
      K = 1
      For i = 1 To UBound(arr)
         If arr(i, 1) Like "*" & str & "*" Then
            cxArr(K, 1) = arr(i, 1)
            cxArr(K, 2) = arr(i, 2)
            cxArr(K, 3) = arr(i, 3)
            cxArr(K, 4) = arr(i, 4)
            cxArr(K, 5) = arr(i, 5)
            cxArr(K, 6) = arr(i, 6)
            cxArr(K, 7) = arr(i, 7)
            cxArr(K, 8) = arr(i, 8)
            cxArr(K, 9) = arr(i, 9)
            cxArr(K, 10) = arr(i, 10)
            cxArr(K, 11) = arr(i, 11)
            K = K + 1
         End If
      Next
      Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
End If

End Sub

akk0415 · 发表于 2019-12-5 16:07

NadrsSaber 发表于 2019-12-5 15:06
Sub 按钮1_Click()

Dim str$, cxrow!, num&

大佬，想请教下，如何弄成显示内容单元格自带边框线啊

NadrsSaber · 发表于 2019-12-5 16:16

akk0415 发表于 2019-12-5 16:07
大佬，想请教下，如何弄成显示内容单元格自带边框线啊

Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
后面加一句
Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1).Borders.LineStyle = xlContinuous

akk0415 · 发表于 2019-12-5 16:35

NadrsSaber 发表于 2019-12-5 16:16
Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
后面加一句
Sheet1.R ...

谢谢，我用录制宏添加了清除边框线，你帮我看下这样可以吗
Sub 按钮1_Click()
Range("A5:l5000").Value = ""
Dim str$, cxrow!, num&
str = Sheet1.[C2]
cxrow = 5
num = 0

If Not IsEmpty(str) Then
      Dim arr, r&
      r = Sheet2.Range("A1").End(xlDown).Row
      arr = Sheet2.Range("A2:K" & r)
      For i = 1 To UBound(arr)
         If arr(i, 1) Like "*" & str & "*" Then
            num = num + 1
         End If
      Next
      Dim cxArr
      ReDim cxArr(1 To num, 1 To 11)
      k = 1
      For i = 1 To UBound(arr)
         If arr(i, 1) Like "*" & str & "*" Then
            cxArr(k, 1) = arr(i, 1)
            cxArr(k, 2) = arr(i, 2)
            cxArr(k, 3) = arr(i, 3)
            cxArr(k, 4) = arr(i, 4)
            cxArr(k, 5) = arr(i, 5)
            cxArr(k, 6) = arr(i, 6)
            cxArr(k, 7) = arr(i, 7)
            cxArr(k, 8) = arr(i, 8)
            cxArr(k, 9) = arr(i, 9)
            cxArr(k, 10) = arr(i, 10)
            cxArr(k, 11) = arr(i, 11)
            k = k + 1
         End If
      Next
      Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
End If
Dim rag As Range
   Cells.Borders(xlDiagonalDown).LineStyle = xlLineStyleNone
Cells.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
Cells.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone
Cells.Borders(xlEdgeTop).LineStyle = xlLineStyleNone
Cells.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
Cells.Borders(xlEdgeRight).LineStyle = xlLineStyleNone
Cells.Borders(xlInsideVertical).LineStyle = xlLineStyleNone
Cells.Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1).Borders.LineStyle = xlContinuous

End Sub

akk0415 · 发表于 2019-12-5 16:50

NadrsSaber 发表于 2019-12-5 16:16
Sheet1.Range("B" & cxrow & ":L" & cxrow + num - 1) = cxArr
后面加一句
Sheet1.R ...

还有个问题，就是输入没有的型号就弹出运行时错误9

NadrsSaber · 发表于 2019-12-5 16:55

      For i = 1 To UBound(arr)
         If arr(i, 1) Like "*" & str & "*" Then
               num = num + 1
         End If
      Next

后面加一句
if num = 0 then exit sub

1016373263 · 发表于 2019-12-5 16:59

vba+ado+sql很简单

YZC51 · 发表于 2020-1-8 10:20

请参考

查找.zip (189.55 KB, 下载次数: 7)

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

[求助] 求大神帮忙做个查询功能的表格

评分

评分

最新热点 /1