请问如何使用VB查找替换excel中指定字符
请问各位老师,我有若干表格,每个表格中需要替换一些固定的字符,我想用VB写一个程序,直接把表格中指定文字字符替换掉,我是VB新手,请各位老师指点下,小弟没有分了
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