用VB快速读取EXCEL中的数据到数组中的例子

[zjp009988700]

Public Sub GetGuJiaFromExcel(ByVal fs As String, ByVal r1 As Long, ByVal r2 As Long) '''''打开Excel文件读取数据
On Error GoTo Ends:
Dim mybb As Variant
Dim i As Long
Dim j As Long
Dim hao1 As Long
Dim Index1 As Long

If r1 < 1 Then Exit Sub
If r2 < r1 Then Exit Sub

Set oExcel = CreateObject("excel.application")
oExcel.Visible = True
Set oBook = oExcel.Workbooks.Open(fs)
Set oSheet = oBook.Worksheets(1)

mybb = oExcel.Range(Cells(r1, 1), Cells(r2, 6))
For i = 1 To r2 - r1 + 1
    hao1 = Val(mybb(i, 1))
    Index1 = GetGuIndex(hao1)
    If Index1 > 0 And Index1 <= nGu Then
       Gu(Index1).TimJiaBefore = Val(mybb(i, 3))
       Gu(Index1).TimJiaMax = Val(mybb(i, 4))
       Gu(Index1).TimJiaMin = Val(mybb(i, 5))
       Gu(Index1).TimJiaEnd = Val(mybb(i, 6))
    End If
   
Next
Ends:
oExcel.Quit
Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing

End Sub

[专注VB编程开发20年]

这是什么，有用的吗？

[专注VB编程开发20年]

'┏〓〓〓〓〓〓〓〓〓 GetExcelRs,start 〓〓〓〓〓〓〓〓〓┓
'［简介］：
'VB读取EXCEL工作薄某个表中数据
Function GetExcelRs(ByVal sFile As String, Optional ExcelSheetName As String = "sheet1", Optional ErrInfo As String) As ADODB.Recordset
   'VB源码，帮你写函数，帮你写代码，帮你写模块，帮你设计软件
   '--需要什么函数或功能，可以联系我。
   '版权所有，请保留作者信息.QQ：1085992075
   '如需商业用途请联系作者
   On Error GoTo Err
   Dim RS As ADODB.Recordset
   Set RS = New ADODB.Recordset
   Dim ConnStr As String
   ConnStr = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sFile & ";ReadOnly=False"
   
   RS.Open "SELECT * FROM [" & ExcelSheetName & "$]", ConnStr, 1, 3
   
   Set GetExcelRs = RS
   Set RS = Nothing
   
   Exit Function
   Err:
   ErrInfo = Err.Description
   MsgBox ErrInfo
End Function
'┗〓〓〓〓〓〓〓〓〓  GetExcelRs,end  〓〓〓〓〓〓〓〓〓┛

[无·法]

[Quote=引用 2 楼 xiaoyao961 的回复:]

VB code
'┏〓〓〓〓〓〓〓〓〓 GetExcelRs,start 〓〓〓〓〓〓〓〓〓┓
'［简介］：
'VB读取EXCEL工作薄某个表中数据
Function GetExcelRs(ByVal sFile As String, Optional ExcelSheetName As String = "sheet1", Optional ErrInfo As String) As ADO……
[/Quote]对于不规则的数据还是用com接口读取的好。

[cike_1111]

下面是一个[用VB创建一个xls文件][并向里面写入一个数据]的例子 和LZ的反过来了

注意:本例题程序必须引用 Microsoft Excel 11.0 Object Library

'Form = Command1 
'引用 Microsoft Excel 11.0 Object Library 
'完成效果：在D盘下建立一个名字为 2的 excel文件 文件中的第5列第5行有“成功字样” 
'*************下面是代码*************** 

Dim xlapp As Excel.Application 
Dim xlbook As Excel.Workbook 
Dim xlsheet As Excel.Worksheet 
Private Sub Command1_Click() 

Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象 
Set xlbook = xlapp.Workbooks.Add() 
Set xlsheet = xlbook.Worksheets("Sheet1") '设置活动工作表 

xlsheet.Cells(5, 5) = "成功" '向第五行第五列写入该数据 


xlbook.SaveAs "D:.xls" '另存文件 


xlbook.Close '关闭工作簿 
Set xlbook = Nothing '从内存中清除 

xlapp.Quit '关闭excel 
Set xlapp = Nothing '从内存中清除 

End Sub