10
[ 标签：vb,excel 数据,数据 ]
我要写个VB的小程序，在vb程序里输入内容去查找excel表是否有这个数据。要精确查找的，如果没有这条数据就自动添加一行在excel里。因小弟不是做VB开发的，在自己试验了多次后还是不行，可以模糊查找出来但不能精确查找。希望vb高手帮忙给个小实例。分有的是。neng
问题补充 2009-11-18 10:26
Private Sub Command1_Click()
Dim ExApp As New Excel.Application
Dim Exb As Excel.Workbook
Dim Exsh As Excel.Worksheet
Dim count As Integer
Dim Rz() As String
ExApp.Workbooks.Open App.Path & "\\" & "停车券及咖啡申领" & ".xls" 'excel路径
Set Exb = ExApp.Workbooks(1)
Set Exsh = Exb.Worksheets("免费咖啡申领")
For i = 1 To Exsh.UsedRange.Rows.count
For j = Asc("B") To Asc("B")
If InStr(Exsh.Range(Chr(j) & i), Text2.Text) > 0 Then
usercard(0).Caption = Exsh.Range(Chr(j) & i).Value
MsgBox "已领取！'"
End If
Next j
Next i
ExApp.Workbooks.Close
ExApp.Quit
Set ExApp = Nothing
End Sub
我现在是模糊查询 并让他显示出在vb里
□刺猬□ 回答:5 人气:5 解决时间:2009-11-18 15:06
满意答案
好评率：0%
Private Sub Command1_Click()
Dim ExApp As New Excel.Application
Dim Exb As Excel.Workbook
Dim Exsh As Excel.Worksheet
Dim ahha As Integer
Dim Rz() As String
ahha = 0
ExApp.Workbooks.Open App.Path & "\\" & "停车券及咖啡申领" & ".xls" 'excel路径
Set Exb = ExApp.Workbooks(1)
Set Exsh = Exb.Worksheets("免费咖啡申领")
For i = 1 To Exsh.UsedRange.Rows.count
For j = Asc("B") To Asc("B")
If Exsh.Range(Chr(j) & i) = Text2.Text) > 0 Then
usercard(0).Caption = Exsh.Range(Chr(j) & i).Value
MsgBox "已领取！'"
ahha = 5
End If
Next j
Next i
if ahha = 0 then Exsh.Range("B" & Exsh.UsedRange.Rows.count + 1) = text2.text
ExApp.Workbooks.Close
ExApp.Quit
Set ExApp = Nothing
End Sub
增加了一if语句，就可以写入没有的了。
提问人的追问 2009-11-18 13:53
为什么我这写入的时候，提示是否保存excel表，然后我点保存 我打开看表里面还是没有我插入的数据。
评价答案
∙您已经评价过！
好:0
∙您已经评价过！
一般:0
∙您已经评价过！
不好:0
∙您已经评价过！
原创:0
∙您已经评价过！
非原创:0
:)HE 回答采纳率:42.9% 2009-11-18 12:08
满意答案
好评率：0%
给你个示例程序，一个按钮，command1，一个TEXT1，一个test.XLS跟程序放一个目录
Private Sub Command1_Click()
Dim ExApp As New Excel.Application
Dim Exb As Excel.Workbook
Dim Exsh As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Dim R1 As Excel.Range
Dim count As Integer
Dim Rz() As String
ExApp.Workbooks.Open App.Path & "\est.xls" 'excel路径
Set Exb = ExApp.Workbooks(1)
Set Exsh = Exb.Worksheets("Sheet1")
For i = 1 To Exsh.UsedRange.Rows.count
For j = Asc("A") To Asc("T")
If InStr(Exsh.Range(Chr(j) & i), Text1.Text) > 0 Then
count = count + 1 '统计个数
ReDim Preserve Rz(0 To count) '更改数组尺寸
Rz(count - 1) = Chr(j) & i '保存数据
Debug.Print Rz(count - 1)
End If
Next j
Next i
ExApp.Workbooks.Close
ExApp.Quit
Set ExApp = Nothing
End Sub
运行看看
提问人的追问 2009-11-18 10:28
我就是根据这个改的 大哥。！~ 可是不行
团队的补充 2009-11-18 10:56
我明白你说的意思了，问题出在这句If InStr(Exsh.Range(Chr(j) & i), Text2.Text) > 0 Then
改成If Exsh.Range(Chr(j) & i)=Text2.Text) Then
就可以准确查询了下载本文
