VB操作Excel信息录入与查询

为了理解VB具体如何操作Excel，包括创建，打开，写入，读取等基本操作，闲暇之余编写测试，在此留以备用。

I.VB创建Excel表:
'定义Excel操作变量 Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet '创建Excel进程，并打开目标Excel文件 Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) xlBook.SaveAs "路径/文件名"

II.VB打开Excel表:
'定义Excel操作变量 Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet '打开目标Excel文件 Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open("路径/文件名") Set xlSheet = xlBook.Sheets(1) xlBook.Save

III.VB关闭Excel表:
'定义Excel操作变量 Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet '已经打开目标Excel文件 Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open("路径/文件名") Set xlSheet = xlBook.Sheets(1) xlBook.Save '关闭目标Excel文件 xlApp.Quit Set xlBook = Nothing Set xlSheet = Nothing Set xlApp = Nothing

IV.VB写入Excel表:
'定义Excel操作变量 Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet '打开目标Excel文件并且写入 Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open(“路径/文件名") Set xlSheet = xlBook.Sheets(1) With xlSheet .Cells(1,1) = "A" .Cells(1,2) = "B" .Cells(1,3) = "C" End With xlBook.Save

V.VB读取Excel表:
'定义Excel操作变量 Dim xlApp As New Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet '定义用于保存Excel单元格内容的字符串 Dim xlString As String '定义整形变量用于保存Excel表的行数与列数 Dim xlNum,xlCol As Integer '打开目标Excel文件并且读取保存Excel内容 Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open("路径/文件名") Set xlSheet = xlBook.Sheets(1) '读取Excel表中记录行数 xlNum = xlSheet.UsedRange.Rows.Count '读取Excel表中记录列数 xlCol = xlSheet.UsedRange.Columns.Count '读取Excel表中i行j列单元格内容 xlString = Trim$(xlSheet.Cells(i,j)) xlBook.Save

VB操作Excel足彩信息录入与查询
创建VB应用程序，文件->新建工程->标准EXE，确认。

应用程序源码
Private Declare Function SetWindowPos& Lib "user32" (ByVal hwnd As Long,ByVal hWndInsertAfter As Long,ByVal X As Long,ByVal Y As Long,ByVal cx As Long,ByVal cy As Long,ByVal wFlags As Long) '定义Excel类 Dim xlApp As New Excel.Application '定义工作簿类 Dim xlBook As Excel.Workbook '定义工作表类 Dim xlSheet As Excel.Worksheet '定义文件名 Dim xlFile As String '定义行列数量名 Dim xlNum As Integer Dim xlCol As Integer '定义计数器 Dim i As Integer Dim j As Integer Dim m As Integer Dim n As Integer '定义判断符 Dim IsRepeat As Boolean '定义字符串 Dim strTemp(9999) As String '--------------------------------程序加载------------------------------------------ Private Sub Form_Load() xlFile = App.Path + "/football.xls" '判断是否打开并建立 If Dir(xlFile) <> "" Then Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open(xlFile) Set xlSheet = xlBook.Sheets(1) xlBook.Save '读取记录行数 xlNum = xlSheet.UsedRange.Rows.Count '读取记录列数 xlCol = xlSheet.UsedRange.Columns.Count '读取xlSheet中的行数 lblInfo.Caption = "目标表中共有" + Str(xlNum - 1) + " 条信息" '添加所有数据信息到显示列表 For i = 0 To xlNum - 2 For j = 0 To xlCol - 1 strTemp(i) = strTemp(i) + Trim$(xlSheet.Cells(i + 2,j + 1)) + "," Next j Next i With lstInfo For n = 0 To xlNum - 2 .AddItem strTemp(n) Next n End With '生成按日期查询候选目录 With comboDate .AddItem "" '依次添加日期候选目录 For i = 2 To xlNum If Trim$(xlSheet.Cells(i,1)) <> "" Then IsRepeat = False '依次与同列前面单元格内容进行对比 For j = 1 To i - 1 If Trim$(xlSheet.Cells(i,1)) = Trim$(xlSheet.Cells(j,1)) Then '若与同列前面单元格内容重复,则重复判断符置为True IsRepeat = True End If Next j '对比结束若无重复,则添加该项到候选目录 If IsRepeat = False Then .AddItem xlSheet.Cells(i,1) End If End If Next i End With '生成按公司查询候选目录 With comboCompany .AddItem "" '依次添加公司候选目录 For i = 2 To xlNum If Trim$(xlSheet.Cells(i,2)) <> "" Then IsRepeat = False '依次与同列前面单元格内容进行对比 For j = 1 To i - 1 If Trim$(xlSheet.Cells(i,2)) = Trim$(xlSheet.Cells(j,2)) Then '若与同列前面单元格内容重复,2) End If End If Next i End With '生成按主队查询候选目录 With comboHome .AddItem "" '依次添加主队候选目录 For i = 2 To xlNum If Trim$(xlSheet.Cells(i,3)) <> "" Then IsRepeat = False '依次与同列前面单元格内容进行对比 For j = 1 To i - 1 If Trim$(xlSheet.Cells(i,3)) = Trim$(xlSheet.Cells(j,3)) Then '若与同列前面单元格内容重复,3) End If End If Next i End With '生成按客队查询候选目录 With comboGuest .AddItem "" '依次添加主队候选目录 For i = 2 To xlNum If Trim$(xlSheet.Cells(i,6)) <> "" Then IsRepeat = False '依次与同列前面单元格内容进行对比 For j = 1 To i - 1 If Trim$(xlSheet.Cells(i,6)) = Trim$(xlSheet.Cells(j,6)) Then '若与同列前面单元格内容重复,6) End If End If Next i End With Else MsgBox ("指定文档不存在，新建到应用程序目录。") Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Add Set xlSheet = xlBook.Worksheets(1) With xlSheet .Cells(1,1) = "日期" .Cells(1,2) = "公司" .Cells(1,3) = "主队" .Cells(1,4) = "主队得分" .Cells(1,5) = "客队得分" .Cells(1,6) = "客队" .Cells(1,7) = "欧初胜" .Cells(1,8) = "欧初平" .Cells(1,9) = "欧初负" .Cells(1,10) = "欧终胜" .Cells(1,11) = "欧终平" .Cells(1,12) = "欧终负" .Cells(1,13) = "主初胜" .Cells(1,14) = "初和" .Cells(1,15) = "客初胜" .Cells(1,16) = "主终胜" .Cells(1,17) = "终和" .Cells(1,18) = "客终胜" .Cells(1,19) = "盘路" .Cells(2,1) = txtDate.Text .Cells(2,2) = txtCompany.Text .Cells(2,3) = txtHome.Text .Cells(2,4) = txtHomescore.Text .Cells(2,5) = txtGuestscore.Text .Cells(2,6) = txtguest.Text .Cells(2,7) = txtEroupPreWin.Text .Cells(2,8) = txtEroupPreDraw.Text .Cells(2,9) = txtEroupPreLose.Text .Cells(2,10) = txtEroupFinalWin.Text .Cells(2,11) = txtEroupFinalDraw.Text .Cells(2,12) = txtEroupFinalLose.Text .Cells(2,13) = txtHomePreWin.Text .Cells(2,14) = txtPreDraw.Text .Cells(2,15) = txtGuestPreWin.Text .Cells(2,16) = txtHomeFinalWin.Text .Cells(2,17) = txtFinalDraw.Text .Cells(2,18) = txtGuestFinalWin.Text .Cells(2,19) = txtPanlu.Text End With xlBook.SaveAs xlFile End If '退出进程,关闭相关操作对象 xlApp.Quit Set xlBook = Nothing Set xlSheet = Nothing Set xlApp = Nothing End Sub '--------------------------------查看所有---------------------------------------- Private Sub btnShow_Click() xlFile = App.Path + "/football.xls" '判断是否打开并建立 If Dir(xlFile) <> "" Then Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open(xlFile) Set xlSheet = xlBook.Sheets(1) xlBook.Save '读取记录行数 xlNum = xlSheet.UsedRange.Rows.Count '读取记录列数 xlCol = xlSheet.UsedRange.Columns.Count '读取xlSheet中的行数 lblInfo.Caption = "目标表中共有" + Str(xlNum - 1) + " 条信息" '添加所有数据信息到显示列表 For i = 0 To xlNum - 2 strTemp(i) = "" For j = 0 To xlCol - 1 strTemp(i) = strTemp(i) + Trim$(xlSheet.Cells(i + 2," Next j Next i With lstInfo .Clear For n = 0 To xlNum - 2 .AddItem strTemp(n) Next n End With Else MsgBox ("指定文档不存在，无法查看所有记录。") End If '退出进程,关闭相关操作对象 xlApp.Quit Set xlBook = Nothing Set xlSheet = Nothing Set xlApp = Nothing End Sub '--------------------------------添加记录------------------------------------------ '读取文件，显示信息 Private Sub btnAdd_Click() '定义目标文件和源文件及路径 xlFile = App.Path + "/football.xls" '判断是否打开并建立 If Dir(xlFile) <> "" Then If txtDate.Text = "" And txtCompany.Text = "" And txtHome.Text = "" And txtHomescore.Text = "" And txtGuestscore.Text = "" And txtguest.Text = "" And txtEroupPreWin.Text = "" And txtEroupPreDraw.Text = "" And txtEroupPreLose.Text = "" And txtEroupFinalWin.Text = "" And txtEroupFinalDraw.Text = "" And txtEroupFinalLose.Text = "" And txtHomePreWin.Text = "" And txtPreDraw.Text = "" And txtGuestPreWin.Text = "" And txtHomeFinalWin.Text = "" And txtFinalDraw.Text = "" And txtGuestFinalWin.Text = "" And txtPanlu.Text = "" Then MsgBox ("添加记录失败，请输入任意有效数据值。") Else '可见开关 xlApp.Visible = True '提示开关 xlApp.DisplayAlerts = False '打开目标文件和源文件 Set xlBook = xlApp.Workbooks.Open(xlFile) '打开目标表 Set xlSheet = xlBook.Worksheets(1) '显示记录数量 xlNum = xlSheet.UsedRange.Rows.Count '读取xlSheet中的行数 lblInfo.Caption = "目标表中共有" + Str(xlNum) + " 条信息" 'lblTitle.Caption = comboDate.Text + comboCompany.Text + comboHome.Text + comboGuest.Text '开关激活目标表,便眼观察 'xlSheet.Activate With xlSheet .Cells(xlNum + 1,1) = txtDate.Text .Cells(xlNum + 1,2) = txtCompany.Text .Cells(xlNum + 1,3) = txtHome.Text .Cells(xlNum + 1,4) = txtHomescore.Text .Cells(xlNum + 1,5) = txtGuestscore.Text .Cells(xlNum + 1,6) = txtguest.Text .Cells(xlNum + 1,7) = txtEroupPreWin.Text .Cells(xlNum + 1,8) = txtEroupPreDraw.Text .Cells(xlNum + 1,9) = txtEroupPreLose.Text .Cells(xlNum + 1,10) = txtEroupFinalWin.Text .Cells(xlNum + 1,11) = txtEroupFinalDraw.Text .Cells(xlNum + 1,12) = txtEroupFinalLose.Text .Cells(xlNum + 1,13) = txtHomePreWin.Text .Cells(xlNum + 1,14) = txtPreDraw.Text .Cells(xlNum + 1,15) = txtGuestPreWin.Text .Cells(xlNum + 1,16) = txtHomeFinalWin.Text .Cells(xlNum + 1,17) = txtFinalDraw.Text .Cells(xlNum + 1,18) = txtGuestFinalWin.Text .Cells(xlNum + 1,19) = txtPanlu.Text End With '添加新数据信息后,实时更新显示所有数据信息列表 For i = 0 To xlNum - 2 strTemp(i) = "" For j = 0 To xlCol - 1 strTemp(i) = strTemp(i) + Trim$(xlSheet.Cells(i + 2," Next j Next i With lstInfo .Clear For n = 0 To xlNum - 2 .AddItem strTemp(n) Next n End With strAddTemp = "" For n = 0 To 18 strAddTemp = strAddTemp + Trim$(xlSheet.Cells(xlNum + 1,n + 1)) + "," Next n If strAddTemp <> "," Then With lstInfo .AddItem strAddTemp End With End If '更新按日期查询候选目录 With comboDate .Clear .AddItem "" '依次添加日期候选目录 For i = 2 To xlNum + 1 If Trim$(xlSheet.Cells(i,1) End If End If Next i End With '更新按公司查询候选目录 With comboCompany .Clear .AddItem "" '依次添加公司候选目录 For i = 2 To xlNum + 1 If Trim$(xlSheet.Cells(i,2) End If End If Next i End With '更新按主队查询候选目录 With comboHome .Clear .AddItem "" '依次添加主队候选目录 For i = 2 To xlNum + 1 If Trim$(xlSheet.Cells(i,3) End If End If Next i End With '更新按客队查询候选目录 With comboGuest .Clear .AddItem "" '依次添加主队候选目录 For i = 2 To xlNum + 1 If Trim$(xlSheet.Cells(i,6) End If End If Next i End With xlBook.Save End If End If '退出进程,关闭相关操作对象 xlApp.Quit Set xlBook = Nothing Set xlSheet = Nothing Set xlApp = Nothing End Sub '--------------------------------查询记录------------------------------------------ Private Sub btnSearch_Click() xlFile = App.Path + "/football.xls" Set xlApp = New Excel.Application xlApp.Visible = True xlApp.DisplayAlerts = False Set xlBook = xlApp.Workbooks.Open(xlFile) Set xlSheet = xlBook.Sheets(1) '读取记录行数 xlNum = xlSheet.UsedRange.Rows.Count '读取记录列数 xlCol = xlSheet.UsedRange.Columns.Count '若无查询条件,则返回所有数据信息作为查询值,显示到数据信息列表 If comboDate.Text = "" And comboCompany.Text = "" And comboHome.Text = "" And comboGuest.Text = "" Then m = 0 For i = 0 To xlNum - 2 strTemp(i) = "" For j = 0 To xlCol - 1 strTemp(i) = strTemp(i) + Trim$(xlSheet.Cells(i + 2," Next j Next i With lstInfo .Clear For n = 0 To xlNum - 2 .AddItem strTemp(n) Next n End With lblSearchInfo.Caption = "目标表中共有" + Str(xlNum - 1) + " 条记录符合搜索条件" '若有查询条件,则开始进入查询,返回查询结果,显示到数据信息列表 Else m = 0 With lstInfo '清空数据信息列表 .Clear '查询条件,日期,公司,主队,客队 If comboDate.Text <> "" And comboCompany.Text <> "" And comboHome.Text <> "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,1) And comboCompany.Text = xlSheet.Cells(i,2) And comboHome.Text = xlSheet.Cells(i,3) And comboGuest.Text = xlSheet.Cells(i,6) Then m = m + 1 .AddItem strTemp(i - 2) End If Next i End If '查询条件,日期 If comboDate.Text <> "" And comboCompany.Text = "" And comboHome.Text = "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,1) Then m = m + 1 .AddItem strTemp(i - 2) End If Next i End If '查询条件,公司 If comboDate.Text = "" And comboCompany.Text <> "" And comboHome.Text = "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboCompany.Text = xlSheet.Cells(i,2) Then m = m + 1 .AddItem strTemp(i - 2) End If Next i End If '查询条件,主队 If comboDate.Text = "" And comboCompany.Text = "" And comboHome.Text <> "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboHome.Text = xlSheet.Cells(i,3) Then m = m + 1 .AddItem strTemp(i - 2) End If Next i End If '查询条件,客队 If comboDate.Text = "" And comboCompany.Text = "" And comboHome.Text = "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboGuest.Text = xlSheet.Cells(i,公司 If comboDate.Text <> "" And comboCompany.Text <> "" And comboHome.Text = "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,主队 If comboDate.Text <> "" And comboCompany.Text = "" And comboHome.Text <> "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,1) And comboHome.Text = xlSheet.Cells(i,客队 If comboDate.Text <> "" And comboCompany.Text = "" And comboHome.Text = "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,1) And comboGuest.Text = xlSheet.Cells(i,主队 If comboDate.Text = "" And comboCompany.Text <> "" And comboHome.Text <> "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboCompany.Text = xlSheet.Cells(i,客队 If comboDate.Text = "" And comboCompany.Text <> "" And comboHome.Text = "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboCompany.Text = xlSheet.Cells(i,2) And comboGuest.Text = xlSheet.Cells(i,客队 If comboDate.Text = "" And comboCompany.Text = "" And comboHome.Text <> "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboHome.Text = xlSheet.Cells(i,客队 If comboDate.Text = "" And comboCompany.Text <> "" And comboHome.Text <> "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboCompany.Text = xlSheet.Cells(i,客队 If comboDate.Text <> "" And comboCompany.Text = "" And comboHome.Text <> "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,客队 If comboDate.Text <> "" And comboCompany.Text <> "" And comboHome.Text = "" And comboGuest.Text <> "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,主队 If comboDate.Text <> "" And comboCompany.Text <> "" And comboHome.Text <> "" And comboGuest.Text = "" Then For i = 2 To xlNum If comboDate.Text = xlSheet.Cells(i,3) Then m = m + 1 .AddItem strTemp(i - 2) End If Next i End If End With lblSearchInfo.Caption = "目标表中共有" + Str(m) + " 条记录符合搜索条件" End If '退出进程,关闭相关操作对象 xlApp.Quit Set xlBook = Nothing Set xlSheet = Nothing Set xlApp = Nothing End Sub

附表，添加控件，如下：

CommandButton控件
btnShow
btnAdd
btnSearch

ComboBox控件
comboDate
comboCompany
comboHome
comboGuest

Frame控件
frmInfo

ListBox控件
lstInfo

Label控件
lblDate
lblCompany
lblHome
lblHomescore
lblGuestscore
lblguest
lblEroupPreWin
lblEroupPreDraw
lblEroupPreLose
lblEroupFinalWin
lblEroupFinalDraw
lblEroupFinalLose
lblHomePreWin
lblPreDraw
lblGuestPreWin
lblHomeFinalWin
lblFinalDraw
lblGuestFinalWin
lblPanlu
lblInfo
lblSearch
lblSearchInfo
lblSearchDate
lblSearchCompany
lblSearchHome
lblSearchGuest

TextBox控件txtDatetxtCompanytxtHometxtHomescoretxtGuestscoretxtguesttxtEroupPreWintxtEroupPreDrawtxtEroupPreLosetxtEroupFinalWintxtEroupFinalDrawtxtEroupFinalLosetxtHomePreWintxtPreDrawtxtGuestPreWintxtHomeFinalWintxtFinalDrawtxtGuestFinalWintxtPanlu

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!