如题：
如果用普通的方法速度太慢了，有没有快速的方法将vb中德得到的数据保存到Excel文件中。在读取时我用了打开数据库的方法，速度上没问题，保存有没有类似的方法？我尝试了，但是保存的数据不是A1开始的,而且保存的数据不是数值型的，而是字符型的。望各位大虾不吝赐教！
如果用普通的方法速度太慢了，有没有快速的方法将vb中德得到的数据保存到Excel文件中。在读取时我用了打开数据库的方法，速度上没问题，保存有没有类似的方法？我尝试了，但是保存的数据不是A1开始的,而且保存的数据不是数值型的，而是字符型的。望各位大虾不吝赐教！
CMG.filename指要保存到的文件名
dcxx是EXCEL中单元表的名称
Bm指数据库的表
sqlwhere指where条件
sqlorder指排序条件这种方式快！
它是一个格式化文本文件，大体格式为：文本行代表表格行
同一行以逗号分隔的内容表示不同字段的内容。楼主可以将一个普通的EXCEL文件，选择另存为CSV格式后，用写字板打开这个文件看一看格式就知道了，非常简单的。并且这样做速度也很快，完全不是那种一格一格写数据可以比拟的。在建立数据接口的时候可以建立一个字符串类型的数组，先将所有内容放在数组里，再用循环写入文件里。
几十万条记录的文件处理时间也不过几秒而已补充一下：你生成的CSV文件，在装有OFFICE的系统上所显示的图标就是一个EXCEL的图标（稍微一点点不同，图标下面多了一个小写的"a"而已），说明OFFICE已经把这种文件注册为默认可打开的文件类型了。需要仔细研究，学会并应用！！！！！！！！！！Rem 快速保存的数据文件格式CSV，可以用EXCEL打开
Private Sub MnuCsv_Click()
Dim i As Integer'窗体
Dim myPic As StdPicture
Set myPic = CapturePic(Picture1)
SavePicture myPic, "c:\myPic.bmp"''写入CSV文件，EXCEL可以打开的文件 Open "D:\11.csv" For Output As #1
Print #1, " 步进序号"; ","; ''''' '这里是写CSV的第一行，固定的列头
Print #1, "nx"; ",";
Print #1, "αi"; ",";
Print #1, "齿尖转动半径"; ",";
Print #1, "Fc"; ",";
Print #1, "Fh"; ",";
Print #1, "Fdt"; ",";
Print #1, "Fdn"; ",";
Print #1, "Fo"; ",";
Print #1, vbNullString ''''结束换行
''''''写入数据
For i = 1 To 546
Print #1, Val(MSFlexGrid1.TextMatrix(i, 0)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 1)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 2)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 3)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 4)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 5)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 6)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 7)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 8)); ",";
Print #1, vbNullString
Next
Close #1End Sub
打开保存文件方式：：
Rem 快速保存的数据文件格式CSV，可以用EXCEL打开
Private Sub MnuCsv_Click()
Dim i As Integer'窗体
Dim myPic As StdPicture
Set myPic = CapturePic(Picture1)
SavePicture myPic, "c:\myPic.bmp"''写入CSV文件，EXCEL可以打开的文件Dim FileName As String '''''''''''将数据保存到Excel表里CommDiag1.FileName = ""
CommDiag1.Filter = "CSV|*.csv"
CommDiag1.ShowSave
FileName = CommDiag1.FileName
If FileName = "" Then
Exit Sub
End If Open FileName For Output As #1
Print #1, " 步进序号"; ","; ''''' '这里是写CSV的第一行，固定的列头
Print #1, "nx"; ",";
Print #1, "αi"; ",";
Print #1, "齿尖转动半径"; ",";
Print #1, "Fc"; ",";
Print #1, "Fh"; ",";
Print #1, "Fdt"; ",";
Print #1, "Fdn"; ",";
Print #1, "Fo"; ",";
Print #1, vbNullString ''''结束换行
''''''写入数据
For i = 1 To 546
Print #1, Val(MSFlexGrid1.TextMatrix(i, 0)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 1)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 2)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 3)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 4)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 5)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 6)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 7)); ",";
Print #1, Val(MSFlexGrid1.TextMatrix(i, 8)); ",";
Print #1, vbNullString
Next
Close #1End Sub
用你的方法的确比较快，不过现在又有个新问题，用这种方法保存的excel文件我用数据库方式打不开了，估计是文件格式不匹配，有没有什么方法与上面保存的方式相匹配的导出excel文件的方法呢？
传统方法很慢的，也应该是打开文件的方式吧！
请赐教!
Dim i As Integer
Dim mondata(1799) As Single
Dim adoConnection As New ADODB.Connection
Dim adoRecordset As New ADODB.RecordsetadoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=D:\ttt.csv;Extended Properties='Excel 8.0;HDR=Yes'"
adoRecordset.Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic
Do Until adoRecordset.EOF
For i = 0 To adoRecordset.Fields.Count - 1
mondata(i) = adoRecordset.Fields.Item(0).Value
Debug.Print adoRecordset.Fields.Item(0).Value
Next i
i = i + 1
adoRecordset.MoveNext
Loop
'adoRecordset.Close
'adoConnection.Close
但是用你的方法保存后，运行上面的程序就报错，为：外部表不是预期的格式这是传统的方法，速度太慢了点
Dim newXls As Excel.Application
Dim newBook As Excel.Workbook
Dim newSheet As Excel.Worksheet
Set newXls = CreateObject("Excel.Application")
Set newBook = newXls.Workbooks.Open(d:\ttt.csv) '打开已经存在的EXCEL工件簿文件
newXls.Visible = False '设置EXCEL对象可见（或不可见）
Set newSheet = newBook.Worksheets(command) '设置活动工作表
For i = 0 To 1799
mondata(i) = Val(newSheet.Cells(i + 1, 1)) '给单元格（row,col）赋值
Next i
newBook.Application.Quit
Set newXls = Nothing
Dim i As Integer
Dim mondata(1799) As Single
Dim adoConnection As New ADODB.Connection
Dim adoRecordset As New ADODB.RecordsetadoConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=D:\ttt.csv;Extended Properties='Excel 8.0;HDR=Yes'"
adoRecordset.Open "select * from [sheet1$]", adoConnection, adOpenKeyset, adLockOptimistic
Do Until adoRecordset.EOF
mondata(i) = adoRecordset.Fields.Item(0).Value
i = i + 1
adoRecordset.MoveNext
Loop
'adoRecordset.Close
'adoConnection.Close
但是用你的方法保存后，运行上面的程序就报错，为：外部表不是预期的格式这是传统的方法，速度太慢了点
Dim newXls As Excel.Application
Dim newBook As Excel.Workbook
Dim newSheet As Excel.Worksheet
Set newXls = CreateObject("Excel.Application")
Set newBook = newXls.Workbooks.Open(d:\ttt.csv) '打开已经存在的EXCEL工件簿文件
newXls.Visible = False '设置EXCEL对象可见（或不可见）
Set newSheet = newBook.Worksheets(command) '设置活动工作表
For i = 0 To 1799
mondata(i) = Val(newSheet.Cells(i + 1, 1)) '给单元格（row,col）赋值
Next i
newBook.Application.Quit
Set newXls = Nothing
Dim strSql As String
Dim keycode As StringOn Error GoTo err
If Trim(Cbo_date1.Text) = "" Or Trim(Cbo_date2.Text) = "" Then
MsgBox "请您选择导出的具体的结算日期!", vbOKOnly + vbExclamation, "警告"
Cbo_date1.SetFocus
End Ifkeycode = Trim(Cbo_date1.Text) & lpad(Trim(Cbo_date2.Text), 2, "0")strSql = "SELECT * FROM t_monthtotal where total_no = '" & Trim(keycode) & "'"ExportExcel (strSql)fin: Exit Sub
err:
MsgBox "存在错误，请检查数据或是检查程序", vbOKOnly + vbExclamation, "警告"
Resume errEnd Sub'''---引用 Microsoft Excel 11.0 Object Library
Public Function ExportExcel(ByVal strSql As String)
On Error GoTo err
' 定義 Excel 對象
Dim priXLS As Excel.Application
Dim priWorkbook As Excel.Workbook
Dim priSheet As Excel.Worksheet
' Rs 臨時記錄集
Dim Rs As New ADODB.Recordset
Dim lngRow As Long, lngRows As Long, intField As Integer, intFields As Integer
Screen.MousePointer = vbHourglass
' 打開記錄集﹐得到數據﹐將數據導入 Excel 表中
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.Provider = "SQLOLEDB"
cnn.Open ConnectString
If Rs.State Then Rs.Close
Rs.Open strSql, cnn, adOpenKeyset, adLockOptimistic
If Rs.RecordCount = 0 Then GoTo err
Set priXLS = New Excel.Application
Set priWorkbook = priXLS.Workbooks.Add
Set priSheet = priXLS.Sheets(1)
With priSheet
intFields = Rs.Fields.Count
'''給字段標頭
For intField = 1 To intFields
.Cells(1, intField) = "'" & Rs(intField - 1).Name
Next
Rs.MoveLast
lngCount = Rs.RecordCount
Rs.MoveFirst
'''給字段的值
For lngID = 1 To lngCount
For intField = 1 To intFields
.Cells(lngID + 1, intField) = "'" & Rs(intField - 1).Value
Next
Rs.MoveNext
Next
End With
priXLS.Visible = True
err:
Screen.MousePointer = 0
End Function
As String
'returns a DB ConnectString
ConnectString = "Server=(local);Database=fin;Uid=sa;Pwd="
End Function
----------Excel自带的方法,非常快.
Screen.MousePointer = vbHourglass '''''''''''表示等待状态
Dim xls As Object 'Excel格式输出数据
Set xls = CreateObject("Excel.Application")
xls.Visible = True
xls.Caption = "Four Signals"
Set xlbook = xls.Workbooks.Add 'Excel格式输出数据
Dim Row As Integer
Dim Col As Integer
Dim i, j As Integer
Dim channelpot As Integer
Dim ch0(511), ch1(511), ch2(511), ch3(511) As Single
channelpot = (4096 - (4096 Mod ChannelCount)) '原型为:channelpot = (8192 - (8192 Mod ChannelCount))
For i = 0 To ChannelCount - 1
s$ = s$ + "| CH" + Str$(Hist_Header.FirstChannel + i)
Next
Grid.FormatString = s$
s$ = ";"
For i = 0 + m_Offset To ((channelpot / ChannelCount) - 1 + m_Offset)
s$ = s$ + "|" + Str$(i)
Next
Grid.FormatString = s$
'Open "D:\05.txt" For Output As #1' '文本格式读出数据
For Row = 1 To ((4096 - (4096 Mod ChannelCount)) / ChannelCount)
Col = 0 ''''''''''''''''''''''''''可以存取数据了 !!!!!!!!!!!!!
Grid.TextMatrix(Row, Col + 1) = Format(((((InRegionUser((Row - 1) * ChannelCount + Col) Xor &H2000) And &H3FFF) - &H2000) * PoltvalueChange) / 1000, "#.00000")
ch0(511) = Grid.TextMatrix(Row, Col + 1)
ch0(511) = Val(ch0(511))
Text3.Text = ch0(511)
xls.Cells(Row, 1).Value = ch0(511) 'Excel格式输出数据
Col = 1 ''''''''''''''''''''''''''可以存取数据了 !!!!!!!!!!!!!
Grid.TextMatrix(Row, Col + 1) = Format(((((InRegionUser((Row - 1) * ChannelCount + Col) Xor &H2000) And &H3FFF) - &H2000) * PoltvalueChange) / 1000, "#.00000")
ch1(511) = Grid.TextMatrix(Row, Col + 1)
ch1(511) = Val(ch1(511))
Text4.Text = ch1(511)
xls.Cells(Row, 2).Value = ch1(511) 'Excel格式输出数据
Col = 2 ''''''''''''''''''''''''''可以存取数据了 !!!!!!!!!!!!!
Grid.TextMatrix(Row, Col + 1) = Format(((((InRegionUser((Row - 1) * ChannelCount + Col) Xor &H2000) And &H3FFF) - &H2000) * PoltvalueChange) / 1000, "#.00000")
ch2(511) = Grid.TextMatrix(Row, Col + 1)
ch2(511) = Val(ch2(511))
Text5.Text = ch2(511)
xls.Cells(Row, 3).Value = ch2(511) 'Excel格式输出数据
Col = 3 ''''''''''''''''''''''''''可以存取数据了 !!!!!!!!!!!!!
Grid.TextMatrix(Row, Col + 1) = Format(((((InRegionUser((Row - 1) * ChannelCount + Col) Xor &H2000) And &H3FFF) - &H2000) * PoltvalueChange) / 1000, "#.00000")
ch3(511) = Grid.TextMatrix(Row, Col + 1)
Text6.Text = ch3(511)
xls.Cells(Row, 4).Value = ch3(511) 'Excel格式输出数据
'Write #1, ch0(511), ch1(511), ch2(511), ch3(511)' '文本格式读出数据
'Draw_Click
'Picture2.PSet (ch0(511), ch2(511)), RGB(255, 0, 255)
Next
'Close #1' '文本格式读出数据
Screen.MousePointer = vbDefault '''''''''''''表示形状由对象确定
End Sub