![]() |
#2
wds12021-05-12 14:17
1、读取execl到内存数组txt1,之后操作二维数组txt1即可
'============================================================ ' 读取EXECL到内存数组【速度快-优选】 ' 输入参数:execl名字、sheet名【需要ADO控件】【Activex Data Object】 ' 输出参数:txt1内存数组 '============================================================ Public Sub read_Execl(ByVal execl_name As String, ByVal sheet1 As String, txt1) Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim i As Long, j As Long If Right(execl_name, Len(execl_name) - InStrRev(execl_name, ".")) = "xls" Then cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;data source=" & execl_name & ";extended properties= 'Excel 8.0;HDR=YES;IMEX=1';" ElseIf Right(execl_name, Len(execl_name) - InStrRev(execl_name, ".")) = "xlsx" Then cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Persist Security Info=False;data source=" & execl_name & ";extended properties= 'Excel 12.0;HDR=YES;IMEX=1';" End If rs.Open "select * from [" & sheet1 & "$]", cn, 1, 1 ReDim txt1(rs.RecordCount, rs.Fields.Count) For i = 1 To rs.Fields.Count: txt1(0, i) = rs.Fields(i - 1).Name: Next i '读第一行【首行当标题了】 For i = 1 To rs.RecordCount '读其余行 For j = 1 To rs.Fields.Count: txt1(i, j) = rs.Fields(j - 1): Next j rs.MoveNext Next i rs.Close Set rs = Nothing Set cn = Nothing End Sub 2、保存execl '============================================================================== ' 保存Execl '【需要引用Microsoft Execl 12 objects Library】 ' 输入:txt1二维数组、Execl的Sheet位置;输出:Execl文件 '============================================================================== Public Sub Write_Execl(ByVal Execl_name, ByVal sheet1, ByVal txt1) Dim NewXls As Excel.Application Dim NewBook As Excel.Workbook Dim NewSheet As Excel.Worksheet Dim objRange As Object Dim nRows As Long, nColumns As Long Set NewXls = CreateObject("Excel.Application") '创建excel应用程序,打开excel2000 NewXls.SheetsInNewWorkbook = sheet1 Set NewBook = NewXls.Workbooks.Add '创建工作簿 Set NewSheet = NewBook.Worksheets(sheet1) '创建工作表 NewXls.DisplayAlerts = False nRows = UBound(txt1, 1) nColumns = UBound(txt1, 2) '导出到Excel中 Set objRange = NewSheet.Range(NewSheet.Cells(1, 1), NewSheet.Cells(nRows, nColumns)) objRange.Value = txt1 DoEvents If Right(Execl_name, Len(Execl_name) - InStrRev(Execl_name, ".")) = "xls" Then NewBook.SaveAs Execl_name, 56 'Excel 97-2003 工作簿 ElseIf Right(Execl_name, Len(Execl_name) - InStrRev(Execl_name, ".")) = "xlsx" Then NewBook.SaveAs Execl_name, 51 End If NewBook.Close Set NewBook = Nothing Set NewXls = Nothing End Sub |
请问各位老师,我有若干表格,每个表格中需要替换一些固定的字符,我想用VB写一个程序,直接把表格中指定文字字符替换掉,我是VB新手,请各位老师指点下,小弟没有分了