<em>VB</em> 读取、查找 <em>excel</em> 数据-

先把excel文件放到指定的路径
然后逐行读取
最后赋值到list中

'引用：
'添加对该对象的引用 工程菜单-->引用，找到 Microsoft Scripting Runtime
'引用microsoft Excel 14.0 object library
'
Dim elApp As Excel.Application
Dim elBooks As Excel.Workbook
Dim ekSheet As Excel.Worksheet
Dim TblMap_Card '创建一个变量

Private Sub Command1_Click()
Dim i As Integer
openEl
Set dic = CreateObject("Scripting.Dictionary")
'MsgBox ekSheet.Cells(Rows.Count, 1).End(3).Row
For i = 2 To ekSheet.Cells(Rows.Count, 1).End(3).Row
If dic.Exists(ekSheet.Cells(i, 2).Value) Then
dic(ekSheet.Cells(i, 1).Value) = dic(ekSheet.Cells(i, 1).Value) + ekSheet.Cells(i, 2).Value
Else
dic(ekSheet.Cells(i, 1).Value) = ekSheet.Cells(i, 2).Value
End If
Next i

ekSheet.Range("H:J").Clear

'ekSheet.Cells(1, 9).Resize(1, 2) = Array("商品", "售量")
ekSheet.Cells(2, 9).Resize(dic.Count, 1) = Application.Transpose(dic.Keys)
ekSheet.Cells(2, 10).Resize(dic.Count, 1) = Application.Transpose(dic.Items)

End Sub

Private Sub openEl()
Dim myPath As String
myPath = "\week.xlsx"
Set elApp = CreateObject("Excel.Application")
Set elBooks = elApp.Workbooks.Open(App.Path & myPath)
Set ekSheet = elBooks.Worksheets("Sheet1")
'Set ekSheet = elBooks.Worksheets(1)
elApp.Visible = True
End Sub

VB6的，测试通过。界面上只有一个按e799bee5baa6e79fa5e98193e58685e5aeb9337钮。

我用的textbox,你也可以改成你的e69da5e6ba90e799bee5baa6e997aee7ad94366那种控件,这个是返回在一个工作簿中的每个工作表中找到的第一个,如果要返回所有找到的,也可以修改.希望可以帮到你.我测试是OK的.
Private Sub CommandButton2_Click()
on error resume next '防止你要输入的a这个表未打开时报错.
Application.ScreenUpdating = False
Dim a As String
Dim b As String
Dim sh As Worksheet
a = TextBox1.Text　'可以改成你的Text1.text
b = TextBox2.Text　'可以改成你的Text2.text
Str1 = "*" & b & "*"
For Each sh In Workbooks(a & ".xls").Worksheets
For Each c In sh.Cells
If c.Value Like Str1 Then '如果要查相等的用c.value=b
x = c.Row
y = c.Column
MsgBox "工作表:" & sh.Name & vbNewLine & "x = " & x & ", y = " & y
Exit For
End If
DoEvents
Next
Next
Application.ScreenUpdating = True
End Sub