EXCEL如何用VBA实现多条件查询数据?

如图,工作簿中有两个表,【数据表】里面存储了仓库里存放模具的相关数据,【查询】就是一个简易的数据查询界面,里面两个文本框一个按钮,需要实现的功能如下:在两个文本框中分别输... 如图,工作簿中有两个表,【数据表】里面存储了仓库里存放模具的相关数据,【查询】就是一个简易的数据查询界面,里面两个文本框一个按钮,需要实现的功能如下:

在两个文本框中分别输入模具的“长度”和“宽度”,点击按钮,系统就会查询出符合条件( 长度-1<=长度<=长度+1 & 宽度-1<=宽度<=宽度+1 )的结果并把它显示在下面的表格中,查询出的结果和输入的数值完全匹配的,就填充浅绿色背景以突出显示(如图)。

求附有注释的代码,谢谢
提问者不能上传文件?
做好的工作簿在这里,就缺代码
http://pan.baidu.com/s/1jHseMDS
展开
 我来答
xiawei123
高粉答主

2019-08-14 · 每个回答都超有意思的
知道答主
回答量:1626
采纳率:100%
帮助的人:47.3万
展开全部

1、以商场2015年第一季度电器销售统计为例子,“产品”、“品牌”、“月份”3个条件的销售额进行查询。

2、假设要查询“康佳”的“1月”份“各类家电”的销售额,先建一个对应列的工作簿。如图,输入条件1:“成品名称”,条件2:“品牌名称”,条件3:“月份”,

3、下面到了建立宏的步骤:单击菜单栏中的“开发工具”——插入——表单控件——按钮,在出现的十字箭头上拖住画出一个按钮,如图所示。

4、在弹出的查找红对话框中选择“录制”,在弹出的“录制新宏”对话框中,修改宏名称为“查找”,单击确定。

5、单击“开发工具”——查看代码,打开VBA编辑器,如图所示。

6、在VBA编辑器点击插入-模块,如图,

7、现在来输入代码:

Sub 查找()

Dim i As Integer, j As Integer

arr1 = Sheets("数据").Range("A2:D" & Sheets("数据").Cells(Rows.Count, "A").End(xlUp).Row)

arr2 = Sheets("查找").Range("A2:D" & Sheets("查找").Cells(Rows.Count, "A").End(xlUp).Row)

For i = 1 To UBound(arr2)

For j = 1 To UBound(arr1)

If arr2(i, 1) = arr1(j, 1) And arr2(i, 2) = arr1(j, 2) And arr2(i, 3) = arr1(j, 3) Then

arr2(i, 4) = arr1(j, 4)

GoTo 100

End If

Next

arr2(i, 4) = ""

100:

Next

Sheets("查找").Range("A2:D" & Sheets("查找").Cells(Rows.Count, "A").End(xlUp).Row) = arr2

End Sub

8、现在回到EXCEL表格,右击按钮,选择“编辑文字”,修改按钮名称为“统计”。

9、那么就完成了。

KeroBerus
推荐于2017-12-16
知道答主
回答量:9
采纳率:0%
帮助的人:4.3万
展开全部
我初学VBA,但这个问题我可以回答,用ADODB实现

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

Dim Conn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim Str_sql As String

Conn.Open ("provider=microsoft.ace.oledb.12.0;extended properties='Excel 12.0;HDR=YES';data source=" & ThisWorkbook.FullName)

Str_sql = "SELECT 编号,类别,长度,宽度,库存 FROM [数据表$] WHERE (长度>=" & TextBox1.Value - 1 & " AND 长度<=" & TextBox1.Value + 1 & ") AND (宽度>=" & TextBox2.Value - 1 & " AND 宽度<=" & TextBox2.Value + 1 & ")"
Rs.Open Str_sql, Conn, adOpenKeyset, adLockReadOnly

If Not Rs.RecordCount = 0 Then
Range("A3:E65536").ClearContents
Range("A3:E65536").Interior.Color = RGB(255, 255, 255)
Range("A3").CopyFromRecordset Rs
Dim A As Long
Dim T1, T2 As Double
T1 = CDbl(TextBox1.Value)
T2 = CDbl(TextBox2.Value)
For A = 3 To Rs.RecordCount + 3
If Cells(A, 3).Value = T1 And Cells(A, 4).Value = T2 Then
Range(Cells(A, 1), Cells(A, 5)).Interior.Color = RGB(169, 208, 142)
End If
Next A
Else
TextBox1.Value = ""
TextBox2.Value = ""
Range("A3:E65536").ClearContents
Range("A3:E65536").Interior.Color = RGB(255, 255, 255)
MsgBox "没有找到合适的刀模!"
End If

Rs.Close
Set Rs = Nothing
Conn.Close
Set Conn = Nothing

Application.ScreenUpdating = True

End Sub

以上代码缺陷在于没有对Textbox1和Textbox2输入的值进行数据验证,这里只能输数字和小数点,如果你输入别的程序就会报错。

可以用【正则表达式】来做数据验证,可惜我不会:(
本回答被提问者采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式