@ni Excel读取和写入

Option Explicit

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim sStartX As String
Dim sStartY As String
Dim sStartXCnt As Long
Dim sStartYCnt As Long
Dim sEndX As String
Dim sEndY As String
Dim sEndXCnt As Long
Dim sEndYCnt As Long
Dim colValueList As Collection
Dim sPreName As String
Dim colPreNameList As Collection
Dim sCatchValue As String
Dim iTargetY As Long
Dim sTargetX As String
Dim sTargetPoint    As String

Dim a1 As String

 Call IsExcelInstalled

' 创建 Excel 应用程序对象
Set xlApp = New Excel.Application

' 打开 Excel 文件
Set xlBook = xlApp.Workbooks.Open("C:\Documents and Settings\JE06387\桌面\QTJTEST\AAA.xlsx")

' 获取第一个工作表
Set xlSheet = xlBook.Sheets(1)

' 读取 A1 单元格的值
MsgBox xlSheet.Range("A1").Value

Dim sStartPoint As Collection
Dim sEndPoint As Collection

sPreName = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P"
sEndYCnt = 24

Set sStartPoint = gfncolTokenize(Text1.Text, ",")
Set sEndPoint = gfncolTokenize(Text2.Text, ",")

Set colPreNameList = gfncolTokenize(sPreName, ",")
'获取A1,B1,C1到P24的值，然后放入List中
For sStartYCnt = 1 To sEndYCnt
    For sStartXCnt = 1 To colPreNameList.Count
        
            sCatchValue = colPreNameList.Item(sStartYCnt) & sStartXCnt
            
            a1 = xlSheet.Range(sCatchValue).Value
            
            a1 = a1 * 20
            
            
            colValueList.Add sCatchValue, a1
            
    Next sStartXCnt
Next sStartYCnt

Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet

' 创建 Excel 应用程序对象
Set xlApp = New Excel.Application

' 打开 Excel 文件
Set xlWorkbook = xlApp.Workbooks.Add()
' 选择工作表
Set xlWorksheet = xlWorkbook.Worksheets("Sheet1")

sTargetX = "F"
'向文件中从F1开始输入
For iTargetY = 1 To colValueList.Count
    
    sTargetPoint = sTargetX & iTargetY
    
    xlWorksheet.Range(sTargetPoint).Value = colValueList.Item(iTargetY)

Next iTargetY

' 重命名工作簿
xlWorkbook.SaveAs ("C:\Documents and Settings\JE06387\桌面\QTJTEST\QTJTEST2\BBB.xlsx")

' 保存并关闭 Excel 文件
xlWorkbook.Save
xlWorkbook.Close
xlApp.Quit

' 释放对象
Set xlWorksheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing

' 关闭 Excel 文件和应用程序
xlBook.Close False
xlApp.Quit

' 释放对象引用
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub

Public Function gfncolTokenize(ByVal psFullStr As String, ByVal psDelim As String, Optional ByVal psSuppleLastNull As Boolean = False) As Collection
    
    Dim iPos As Integer
    Dim sStr As String
    Dim colCollection As New Collection
    Dim sToken As String
    
    '
    '   parse (and modify) a copy of the passed string
    '
    sStr = psFullStr
    
    iPos = InStr(1, sStr, psDelim, 1)
    Do While iPos <> 0
        sToken = Trim$(Left$(sStr, iPos - 1))
        colCollection.Add sToken
        
        sStr = Mid$(sStr, iPos + 1)
        iPos = InStr(1, sStr, psDelim, 1)
    Loop
    
    '
    '   make the remainder of the string the last token
    '
    sToken = Trim$(sStr)
    If psSuppleLastNull = False Then
        If sToken <> "" Then
            colCollection.Add sToken
        End If
    Else
        colCollection.Add sToken
    End If
    
    Set gfncolTokenize = colCollection
    
    Set colCollection = Nothing
        
End Function