使用VB将变量记录中的数据写入EXCEL
VB数据库连接和导入EXCEL
VB数据库连接和导入EXCELDim strDBFile As StringDim gstrFilePath As StringDim gstrConn As StringDim gDatabase As ADODB.ConnectionDim isConnect As BooleanSet conn = New ADODB.ConnectionSet rs = New ADODB.Recordset'连接数据库Adodc1.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" + App.Path+ "\DATA\ysdzltddata.mdb;Persist Security Info=False" 'conn.ConnectionTimeout = 30conn.Open (Adodc1.ConnectionString)'打开数据库'gDatabase = New ADODB.Connection'gDatabase.Open (gstrConn)isConnect = Truesql = "select * from qpxx"Adodc1.RecordSource = sqlAdodc1.Refresh'向数据库插入数据sql = "Insert into QPXX(windowid,ywid,NWP,DWP,NWT,DWLT,DQP,DAPT,DTIMER,TTIMER)"sql = sql & " values("sql = sql & "'" & CStr(WINID) & "'" '窗口sql = sql & ",'" & YWID & "'" '业务号sql = sql & ",'" & CStr(ALLW AI) & "'" '等待人数sql = sql & ",'" & CStr(MALLW AI) & "'" '当天等候最大人数sql = sql & ",'" & CStr(NW_TIME) & "'" '当前等候办理业务最长时间（秒）sql = sql & ",'" & CStr(W_TIME) & "'" '当天等候最长时间（秒） sql = sql & ",'" & CStr(W AITP) & "'" '今天已取票数sql = sql & ",'" & CStr(A V_TIME) & "'" '今天平均排队时间sql = sql & ",'" & CStr(Format(Date, "yyyymmdd")) & "'" '号号日期 sql = sql & ",'" & CStr(Format(TIME, "hhmmss")) & "')" '叫号时间 conn.Execute (sql)'module模块'把数据导入EXCEL中Dim ExcelApp As Object 'Excel.ApplicationDim ExcelWorkBook As Object 'Excel.workbookDim ExcelWorkSheet As Object 'Excel.worksheetPublic Sub printzh()Dim ExcelSheet As ObjectDim strSource, strDestination As StringOn Error Resume NextstrSource = App.Path & "\DATA\bb.xls"'strDestination = .DirectoryPath & "\DATA\Temp.xls"strDestination = App.Path & "\DATA\Temp.xls"'FileCopy(strSource, strDestination)FileCopy strSource, strDestination'TrySet ExcelApp = CreateObject("Excel.Application")'Set ExcelApp = CreateObject("Excel.Sheet")'打开工作薄Set ExcelWorkBook = ExcelApp.Workbooks.Open(strDestination)'选择工作簿Set ExcelWorkSheet = ExcelWorkBook.Sheets("Sheet1")' Dim i As Long, j As Long, k As Long' For i = 0 To Adodc1.Recordset.RecordCount - 1' If k = DataGrid1.VisibleRows Then' DataGrid1.Scroll(0, DataGrid1.VisibleRows)' k = 0' End IfExcelApp.Application.Visible = True '设置Application 对象使Excel 可见Dim j As Integer'在表格的第一个单元中写些文本ExcelSheet.cells(1, 1).Value = "This is column A, row 1"ExcelWorkSheet.cells(1, 1) = "取号信息汇总表"ExcelWorkSheet.cells(1, 10) = Format(Date, "yyyymmdd") ' & Space(2)ExcelWorkSheet.cells(2, 1) = "窗口号"ExcelWorkSheet.cells(2, 2) = "业务号"ExcelWorkSheet.cells(2, 3) = "当前总等待人数"ExcelWorkSheet.cells(2, 4) = "当天总等候最大人数"ExcelWorkSheet.cells(2, 5) = "当前等候办理业务最长时间"ExcelWorkSheet.cells(2, 6) = "当天总等候最长时间"ExcelWorkSheet.cells(2, 7) = "今天已取票数"ExcelWorkSheet.cells(2, 8) = "今天平均排队时长"ExcelWorkSheet.cells(2, 9) = "叫号日期"ExcelWorkSheet.cells(2, 10) = "叫号时间"For j = 1 To Form1.AdodcD.Recordset.RecordCount' Form1.Adodc1.Recordset.Move(j)' Adodc1.Recordset.MoveFirst()'PrintDB(DataGrid1.Columns(0).Value,DataGrid1.Columns(1).Text, DataGrid1.Columns(2).Text)ExcelWorkSheet.cells(j + 3, 1) = Form1.DataGrid1.Columns(0).TextExcelWorkSheet.cells(j + 3, 2) = Form1.DataGrid1.Columns(1).TextExcelWorkSheet.cells(j + 3, 3) = Form1.DataGrid1.Columns(2).TextExcelWorkSheet.cells(j + 3, 4) = Form1.DataGrid1.Columns(3).TextExcelWorkSheet.cells(j + 3, 5) = Form1.DataGrid1.Columns(4).TextExcelWorkSheet.cells(j + 3, 6) = Form1.DataGrid1.Columns(5).TextExcelWorkSheet.cells(j + 3, 7) = Form1.DataGrid1.Columns(6).TextExcelWorkSheet.cells(j + 3, 8) = Form1.DataGrid1.Columns(7).TextExcelWorkSheet.cells(j + 3, 9) = Form1.DataGrid1.Columns(8).TextExcelWorkSheet.cells(j + 3, 10) = Form1.DataGrid1.Columns(9).TextExcelWorkSheet.cells(j + 3, 11) = Form1.DataGrid1.Columns(10).TextForm1.AdodcD.Recordset.MoveNext' Form1.Adodc1.Recordset.Move(j + 1)'i = i + 1Next j' While Form1.Adodc1.Recordset.EOF = False' sum = sum + CInt(CStr(Form1.Adodc1.Recordset.Fields("一般次数")))' Form1.Adodc1.Recordset.MoveNext()' End While' ExcelWorkSheet.Cells(32, 7) = sum' ExcelWorkSheet.Cells(Form1.Adodc1.Recordset.RecordCount + 1, 5)' ExcelWorkSheet.Cells(Form1.Adodc1.Recordset.RecordCount + 1, 6)' ExcelWorkSheet.Cells(Form1.Adodc1.Recordset.RecordCount + 1, 7)' k = k + 1' Next i'向VBA 传数据'PrintDB("1", "2", "3") '可以是DataRow'显示ExcelForm1.AdodcD.Recordset.MoveFirstExcelApp.Visible = TrueExcelWorkBook.SaveAs App.Path & "\DATA\排队信息表.xls" '保存文件'ExcelSheet.SaveAs "C:\ TEST.DOC"' ExcelWorkSheet.PrintOut() '执行打印' ExcelApp.Quit() '退出EXCEL'删除Excel引用ExcelWorkSheet = NothingExcelWorkBook = NothingExcelApp = Nothing'垃圾回收GC.Collect' Catch ex As Exception' MsgBox (ex)' End TryEnd Sub。
VB操作Excel实现读取写入打印
VB操作EXCEL,实现数据写入以及数据组合1】定义EXCEL的一系列操作Dim xlApp As Excel.ApplicationDim ExcelShowStr As StringSet xlApp = CreateObject("Excel.Application")xlApp.Visible = trueAppLog (CStr(Date) & "_" & CStr(Time) & ":Set xlApp=new Excel.Application") Dim xlBook As WorkbookDim xlSheet As WorksheetDim xlrow, sheetIndex, sheetColumn As Integer' ="D:\VB英迈\Template\WriteData.xls" Editable=空值Set xlBook = xlApp.Workbooks.Open(, Editable) '打开EXCEL模板Set xlSheet = xlApp.ActiveSheet--------------------------------------------------------------------------------------------【2】写入数据的操作xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 1)).Merge '合并单元格xlSheet.Cells(beginRow, 1).FormulaR1C1 = CustName '单行插入xlSheet.Cells(beginRow, 1).VerticalAlignment = xlTop '垂直，写入数据的位置，这里为高xlSheet.Cells(beginRow, 2).HorizontalAlignment = xlHAlignCenter '水平写入数据的位置，这里为居中xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 19)).Font.ColorIndex = ConstModule.COLOR_BLUE '单元格的字体颜色xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1, 19)).Font.Bold = True '单元格的数据为粗体显示xlSheet.Range(xlSheet.Cells(beginRow, 1), xlSheet.Cells(endRow - 1,19)).Interior.ColorIndex = ConstModule.COLOR_SILVER '单元格的背景颜色定义数组，一次性写入，列子如下：If DetailRes.RecordCount > 0 ThenDetailRes.MoveFirstFor row2 = 0 To DetailRes.RecordCount - 1Dim arrayProduct(50, 17) As StringarrayProduct(row2, 0) = DetailRes.Fields("Product")arrayProduct(row2, 1) = DetailRes.Fields("rev")arrayProduct(row2, 2) = DetailRes.Fields("sagm")arrayProduct(row2, 3) = DetailRes.Fields("sagm_per") & "%"arrayProduct(row2, 4) = DetailRes.Fields("gp")arrayProduct(row2, 5) = DetailRes.Fields("gp_per") & "%"arrayProduct(row2, 6) = DetailRes.Fields("opex")arrayProduct(row2, 7) = DetailRes.Fields("opex_per") & "%"arrayProduct(row2, 8) = DetailRes.Fields("oper_profit")arrayProduct(row2, 9) = DetailRes.Fields("oper_profit_per") & "%"arrayProduct(row2, 10) = DetailRes.Fields("dio")arrayProduct(row2, 11) = DetailRes.Fields("dpo")arrayProduct(row2, 12) = DetailRes.Fields("dso")arrayProduct(row2, 13) = DetailRes.Fields("working_capital")arrayProduct(row2, 14) = DetailRes.Fields("interests")arrayProduct(row2, 15) = DetailRes.Fields("pre_tax_income")arrayProduct(row2, 16) = DetailRes.Fields("roic") & "%"DetailRes.MoveNextNext row2xlSheet.Range(xlSheet.Cells(beginRow, 3), xlSheet.Cells(endRow - 1, 19)) = arrayProduct() '数组显示--------------------------------------------------------------------------------------------【3-重点】vb操作EXCEL实现数据组合现在需要把单元格1－4行进行数据组合在EXCEL中，只要选中单元格1－4行，在点击菜单> > 数据> > 组及分级显示> > 组合即可达到要求！[注]：若组合时，收缩时数据显示的是最后的那条，在EXCEL文件中，点击数据>> 组及分级显示>> 设置>>(1)把明细数据的下方复选框的选中状态改为不选中(2)把明细数据的右侧复选框的选中状态改为不选中这样设置数据即可达到显示要求vb代码如下：Rows("10:15").SelectSelection.Rows.Group若是需要变量传入，则：Rows(beginRow & ":" & endRow - 1).SelectSelection.Rows.GroupVB操作EXCEL,实现数据读取基于VB和EXCEL的报表设计及打印在现代管理信息系统的开发中，经常涉及到数据信息的分析、加工，最终还需把统计结果形成各种形式的报表提供给领导决策参考，或进行外部交流。
如何通过VBA编程将符合条件的数据库记录输入到EXCEL中
如何通过VBA编程将符合条件的数据库记录输入到EXCEL中现在有access格式的数据表TEST货号货名规格单价....1-01 货品1 1M 250.001-02 货品2 4Kg 100.00 ................N-99 货品N 999 999.99现在我想在EXCEL的单元格中输入货号，通过VBA代码自动从数据表中查找出相应的记录，并在相邻的列分别自动录入货品、规格、单价等内容，从而实现EXCEL自动数据录入。
请问这VBA代码应如何写？谢谢！解答：Private Sub Worksheet_Change(ByVal Target As Range)Dim Rs As New ADODB.RecordsetDim Query As StringDim Cnn As StringWith Application.ScreenUpdating = False.EnableEvents = FalseEnd WithCnn = "Driver=Microsoft Access Driver (*.mdb);DBQ=C:\*.mdb"Query = "SELECT * FROM TEXT WHERE 货号='" & Target & "'"With Rs.Open Query, Cnn, adOpenStatic, adLockReadOnlyIf .RecordCount = 0 ThenMsgBox "没有此货号！"Target.ClearContentsElseTarget.CopyFromRecordset Rs End If.CloseEnd WithWith Application.ScreenUpdating = True.EnableEvents = TrueEnd WithEnd Sub。
WINCCVB脚本写变量到EXCEL
Option ExplicitFunction actionOn Error Resume NextDim objExcelApp,oWorkBook,fs,iBlankLineSet objExcelApp = GetObject(,"Excel.Application")If VarType(objExcelApp)<>vbEmpty ThenobjExcelApp.ActiveWorkbook.SaveSet oWorkBook = objExcelApp.Workbooks.Open("d:\每小时记录.xls")iBlankLine = oWorkBook.SheetS(1).Columns(1).Find("").RowobjExcelApp.sheets(1).Cells(iBlanKLine, 1).Value = Now()'HMIRuntime.Tags("date").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 2).Value = HMIRuntime.Tags("@CurrentUser").Read objExcelApp.sheets(1).Cells(iBlanKLine, 3).Value = HMIRuntime.Tags("Formula_Name_Plc").Read objExcelApp.sheets(1).Cells(iBlanKLine, 4).Value = HMIRuntime.Tags("Record2_1").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 5).Value = HMIRuntime.Tags("rWeightAdd_1").Read objExcelApp.sheets(1).Cells(iBlanKLine, 6).Value = HMIRuntime.Tags("Record2_3").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 7).Value = HMIRuntime.Tags("Record2_4").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 8).Value = HMIRuntime.Tags("Record2_5").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 9).Value = HMIRuntime.Tags("Record2_6").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 10).Value = HMIRuntime.Tags("Record2_7").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 11).Value = HMIRuntime.Tags("Record2_8").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 12).Value = HMIRuntime.Tags("Record2_9").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 13).Value = HMIRuntime.Tags("Record2_10").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 14).Value = HMIRuntime.Tags("Record2_11").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 15).Value = HMIRuntime.Tags("Record2_12").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 16).Value = HMIRuntime.Tags("Record2_13").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 17).Value = HMIRuntime.Tags("Record2_14").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 18).Value = HMIRuntime.Tags("Record2_15").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 19).Value = HMIRuntime.Tags("Record2_16").ReadobjExcelApp.ActiveWorkbook.SaveElseSet fs =CreateObject("Scripting.FileSyStemObject")Set objExcelApp = CreateObject("Excel.Application")objEXcelApp.VIsible = FalseIf fs.FileExiSts("d:\每小时记录.xLs") thenSet oWorkBook = objExcelApp.Workbooks.Open("d:\每小时记录.xls")iBlankLine = oWorkBook.SheetS(1).Columns(1).Find("").RowobjExcelApp.sheets(1).Cells(iBlanKLine, 1).Value = Now()'HMIRuntime.Tags("date").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 2).Value = HMIRuntime.Tags("@CurrentUser").Read objExcelApp.sheets(1).Cells(iBlanKLine, 3).Value = HMIRuntime.Tags("Formula_Name_Plc").Read objExcelApp.sheets(1).Cells(iBlanKLine, 4).Value = HMIRuntime.Tags("Record2_1").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 5).Value = HMIRuntime.Tags("rWeightAdd_1").Read objExcelApp.sheets(1).Cells(iBlanKLine, 6).Value = HMIRuntime.Tags("Record2_3").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 7).Value = HMIRuntime.Tags("Record2_4").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 8).Value = HMIRuntime.Tags("Record2_5").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 9).Value = HMIRuntime.Tags("Record2_6").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 10).Value = HMIRuntime.Tags("Record2_7").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 11).Value = HMIRuntime.Tags("Record2_8").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 12).Value = HMIRuntime.Tags("Record2_9").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 13).Value = HMIRuntime.Tags("Record2_10").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 14).Value = HMIRuntime.Tags("Record2_11").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 15).Value = HMIRuntime.Tags("Record2_12").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 16).Value = HMIRuntime.Tags("Record2_13").ReadobjExcelApp.sheets(1).Cells(iBlanKLine, 17).Value = HMIRuntime.Tags("Record2_14").Read objExcelApp.sheets(1).Cells(iBlanKLine, 18).Value = HMIRuntime.Tags("Record2_15").Read objExcelApp.sheets(1).Cells(iBlanKLine, 19).Value = HMIRuntime.Tags("Record2_16").Read ElseSet oWorkBook =objExcelApp.WorkBooks.AddoWorkBook.SaveAs "d:\每小时记录.xls "Set oWorkBook = objExcelApp.Workbooks.Open("d:\每小时记录.xls")objExcelApp.Workbooks.Open ( "d:\每小时记录.xls" )objExcelApp.sheets(1).CeLls(1, 1).Value ="时间"objExcelApp.sheets(1).CeLls(1, 2).vaLue ="用户"objExcelApp.sheets(1).CeLls(1, 3).Value ="配方名"objExcelApp.sheets(1).CeLls(1, 4).vaLue ="基粉"objExcelApp.sheets(1).CeLls(1, 5).Value ="沸石一"objExcelApp.sheets(1).CeLls(1, 6).vaLue ="芒硝"objExcelApp.sheets(1).CeLls(1, 7).vaLue ="纯碱"objExcelApp.sheets(1).CeLls(1, 8).vaLue ="色点一"objExcelApp.sheets(1).CeLls(1, 9).vaLue ="色点二"objExcelApp.sheets(1).CeLls(1, 10).vaLue ="色点三"objExcelApp.sheets(1).CeLls(1, 11).vaLue ="酶一"objExcelApp.sheets(1).CeLls(1, 12).vaLue ="酶二"objExcelApp.sheets(1).CeLls(1, 13).vaLue ="废粉"objExcelApp.sheets(1).CeLls(1, 14).vaLue ="非离子"objExcelApp.sheets(1).CeLls(1, 15).vaLue ="水溶性"objExcelApp.sheets(1).CeLls(1, 16).vaLue ="香精一"objExcelApp.sheets(1).CeLls(1, 17).vaLue ="香精二"objExcelApp.sheets(1).CeLls(1, 18).vaLue ="预留液体"objExcelApp.sheets(1).CeLls(1,19).vaLue ="沸石二"End IfobjExcelApp.ActiveWorkbook.SaveobjExcelApp.Workbooks.CloseobJexcelApp.QuitSet objExcelApp = NothingEnd IfEnd Function。
vbsqldatagrid数据导出到excel
vbsqldatagrid数据导出到excel你新建一数据工程，在其窗体中添加ADODC数据控件和DATAGRID控件。
添加COMMAND控件，将按钮控件的属性TABINDEX设置为0使用以下代码，可将在DATAGRID控件显示的数据导出到EXCEL，将下列代码中的数据库连接语句和表名改为你自己的数据库和表名：Option ExplicitDim i, j, k As IntegerDim strConn As StringDim pubConn As New adodb.ConnectionDim rsTable As New adodb.RecordsetDim strSQL As StringDim xlapp As VariantDim xlBook As VariantDim xlSHEET As VariantPrivate Sub Command1_Click()Set xlapp = CreateObject("excel.application")Set xlBook = xlapp.workbooks.AddSet xlSHEET = xlBook.worksheets(1)xlapp.Visible = TrueOn Error Resume NextIf Err.Number <> 0 Then Set xlapp = CreateObject("Excel.Application")Set xlBook = xlapp.workbooks.AddSet xlSHEET = xlBook.ActiveSheetFor k = 1 To DataGrid1.Columns.CountxlSHEET.Cells(1, k) = DataGrid1.Columns(k - 1).CaptionNext kFor i = 1 To Adodc1.Recordset.RecordCount + 1For j = 0 To DataGrid1.Columns.CountxlSHEET.Cells(i + 1, j + 1) = Adodc1.Recordset(j) 'Next jAdodc1.Recordset.MoveNextNext iEnd SubPrivate Sub Form_Load()strSQL = "select * from mdlk_sj where 批号='D012'"Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\hxrkgl.mdb;Persist Security Info=False"Adodc1.RecordSource = strSQLAdodc1.RefreshEnd Sub。
关于vb如何从MSFlexGrid空间中把内容导入excel的方法
以下代码写在模块中：'MSHFlexGrid控件导出到ExcelPublic Function ExportFlexDataToExcel(flex As MSFlexGrid, g_CommonDialog As CommonDia log)On Error GoTo ErrHandlerDim xlApp As ObjectDim xlBook As ObjectDim Rows As Integer, Cols As IntegerDim iRow As Integer, hCol As Integer, iCol As IntegerDim New_Col As BooleanDim New_Column As Booleang_CommonDialog.CancelError = TrueOn Error GoTo ErrHandler' 设置标志g_CommonDialog.Flags = cdlOFNHideReadOnly' 设置过滤器g_CommonDialog.Filter = "All Files (*.*)|*.*|Excel Files" & _"(*.xls)|*.xls|Batch Files (*.bat)|*.bat"' 指定缺省的过滤器g_CommonDialog.FilterIndex = 2' 显示“打开”对话框g_CommonDialog.ShowSaveIf flex.Rows <= 1 ThenMsgBox "没有数据！", vbInformation, g_MsgtitleExit FunctionEnd IfSet xlApp = CreateObject("Excel.Application")Set xlBook = xlApp.Workbooks.AddxlApp.Visible = FalseWith flexRows = .RowsCols = .ColsiRow = 0iCol = 1For hCol = 0 To Cols - 1For iRow = 1 To RowsxlApp.Cells(iRow, iCol).Value = .TextMatrix(iRow - 1, hCol)Next iRowiCol = iCol + 1Next hColEnd WithWith xlApp.Rows(1).Font.Bold = True.Cells.Select.Columns.AutoFit.Cells(1, 1).Select' .Application.Visible = TrueEnd WithxlBook.SaveAs (g_CommonDialog.FileName)xlApp.Application.Visible = FalsexlApp.DisplayAlerts = FalsexlApp.QuitSet xlApp = Nothing '"交还控制给ExcelSet xlBook = Nothingflex.SetFocusMsgBox "数据已经导出到Excel中。
在Excel中应用VBA批量导入数据
在Excel中应用VBA批量导入数据1.问题由来当一个漂亮MM向你请教如何录制并修改一个宏，把她每次的实验数据（几十个数据文件）导入Excel时，你感慨道：“很多Excel专家会录制一个宏来解决问题，然后每次使用的时候修改代码并粘贴到需要的地方，对于一个合格的程序员，这是最要命的事情。
”漂亮MM打断并告诉你，她不是程序员，也不想做程序员，然后命令你开始工作。
2.通过录制宏导入数据对于这个无法拒绝的MM，你只好垂头丧气的开始面对要解决的问题，想着MM几年后博士毕业，年薪至少5万，干个3、5年，年薪10万，还有项目提成，平时吃饭、打车、买可乐都可以报销，当然不会像你放弃了自己的专业，做了一个为生计奔波的程序员。
数据文件是仪器生成一系列文本格式的数据文件，格式完全一样，目的是要把每个数据文件导入到Excel中作为一条记录，也就是一行。
那么，你想，可以用VBA写一个程序，然后定位到需要的位置，读入需要的信息就可以了1[①]。
你打开Excel，打开VBA编辑器，准备开始写代码。
“开始录宏吧”，MM提醒了心不在焉的你，你沉默了0.1秒，默念了一下VBA的信条：“万不得已不要写代码，尽量使用Office的功能”。
于是你启动Excel打开这个文本文件，按照弹出的文本文件导入向导对话框的步骤，使用固1[①]这是很多程序员的通病，喜欢从轮子造起，你也一样。
定列宽导入了需要的数据。
数据包括2部分，第一部分是文件头，包括一些数据信息，后面是按行放置的数据，包括结果和误差，MM要的是后边的数据，要把每行的数据和误差放置到相邻的两列（见下图）。
图 1数据文件部分和需要在Excel中的结果数据明白了问题，一切就好办了，打开Excel，然后开始录制宏：首先打开文件，通过导入文本文件向导，读入数据，将特定单元格的数据拷贝到一个目标Excel 文件中，然后关闭这个文本文件，停止录制宏。
录制的宏很长，大概包括2部分。
第一部分是一句打开文件，格式转换的操作，后边一部分是激活不同的文件，拷贝和粘贴不同的Range。
VB操作EXCEL表的常用方法
VB操作EXCEL表的常用方法VB是常用的应用软件开发工具之一，由于VB的报表功能有限，而且一但报表格式发生变化，就得相应修改程序，给应用软件的维护工作带来极大的不便。
因此有很多程序员现在已经充分利用EXECL的强大报表功来实现报表功能。
但由于VB与EXCEL由于分别属于不同的应用系统，如何把它们有机地结合在一起，是一个值得我们研究的课题。
一、 VB读写EXCEL表：VB本身提自动化功能可以读写EXCEL表，其方法如下：1、在工程中引用Microsoft Excel类型库：从'工程'菜单中选择'引用'栏；选择Microsoft Excel 9.0 Object Library（EXCEL2000），然后选择'确定'。
表示在工程中要引用EXCEL类型库。
2、在通用对象的声明过程中定义EXCEL对象：Dim xlApp As Excel.ApplicationDim xlBook As Excel.WorkBookDim xlSheet As Excel.Worksheet3、在程序中操作EXCEL表常用命令：Set xlApp = CreateObject('Excel.Application') '创建EXCEL对象Set xlBook = xlApp.Workbooks.Open('文件名') '打开已经存在的EXCEL工件簿文件xlApp.Visible = True '设置EXCEL对象可见（或不可见）Set xlSheet = xlBook.Worksheets('表名') '设置活动工作表xlApp.Cells(row, col) =值 '给单元格（row,col）赋值XLApp.Cells(i, 1).Interior.ColorIndex = i'设计单元格颜色i=1--56xlSheet.PrintOut '打印工作表xlBook.Close (True) '关闭工作簿xlApp.Quit '结束EXCEL对象Set xlApp = Nothing '释放xlApp对象xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏xlBook.RunAutoMacros (xlAutoClose) '运行EXCEL关闭宏自己用代码就可以获取颜色列表了Sub yansecode()For i = 1 To 56XlApp.Cells(i, 1) = ixlapp.Cells(i, 1).Interior.ColorIndex = iNextEnd Sub4、在运用以上VB命令操作EXCEL表时，除非设置EXCEL对象不可见，否则VB程序可继续执行其它操作，也能够关闭EXCEL，同时也可对EXCEL进行操作。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
使用VB将变量记录中的数据写入EXCEL
一、编程实现
实现此项目需要掌握以下内容：
1.如何使用VB实现数据的写入
2. 如何调用Excel组件
首先，我们需要引入以下两个组件：
' 引入TextStream和Excel组件
Dim fs As Object
Dim xlApp As Object
接着，我们可以使用TextStream组件将变量记录中的数据以文本形式写入文件：
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(Path, True)
For j = 0 To UBound(arr, 2)
For i = 0 To UBound(arr, 1)
a.writeline arr(i, j)
Next
Next
a.Close
最后，我们可以使用Excel组件将文件内容导入到Excel表格中：Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(Path)
For j = 0 To UBound(arr, 2)
For i = 0 To UBound(arr, 1)
xlBook.Sheets(1).Cells(j + 1, i + 1).Value = arr(i, j)
Next
Next
xlBook.Save
xlBook.Close
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
二、变量记录
Dim arr(9, 5) As String
arr(0, 0) = "火星"
arr(1, 0) = "9.572"
arr(2, 0) = "1.666"
arr(4, 0) = "3.379" arr(5, 0) = "4.603" arr(6, 0) = "5.837" arr(7, 0) = "6.953" arr(8, 0) = "7.974" arr(9, 0) = "8.852" arr(0, 1) = "水星" arr(1, 1) = "2.898" arr(2, 1) = "4.867" arr(3, 1) = "3.070" arr(4, 1) = "4.542" arr(5, 1) = "6.083" arr(6, 1) = "7.483" arr(7, 1) = "8.737" arr(8, 1) = "9.924" arr(9, 1) = "10.98" arr(0, 2) = "金星" arr(1, 2) = "7.234"
arr(3, 2) = "12.719" arr(4, 2) = "14.097" arr(5, 2) = "15.308" arr(6, 2) = "16.508" arr(7, 2) = "18.101" arr(8, 2) = "19.115" arr(9, 2) = "20.638" arr(0, 3) = "地球" arr(1, 3) = "6.378" arr(2, 3) = "12.756" arr(3, 3) = "15.155" arr(4, 3) = "17.531"。