精华内容
下载资源
问答
  • vb中将数据保存到excel

    2012-07-18 14:18:39
    实现数据从MSFlexgrid中保存到excel中,自动创建excel
  • 数据导出到Excel的6种方法(VB6)

    千次阅读 2020-02-12 12:48:04
    数据导出到Excel的6种方法(VB6) 在数据操作中,特别是与数据库相关的操作中,我们需要经常导出数据到Excel表格中,下面我们提供了六种方式来将数据导出到Excel表格中: 如果大家C币比较多的话,可以直接下载我整理好...

    数据导出到Excel的6种方法(VB6)

    在数据操作中,特别是与数据库相关的操作中,我们需要经常导出数据到Excel表格中,下面我们提供了六种方式来将数据导出到Excel表格中:
    如果大家C币比较多的话,可以直接下载我整理好的源码:点击此处下载>>>>
    六种导入数据到Excel的方法
    此实例提供了6种导出数据到Excel的方法,说明如下:
    1.通过获取Excel对象,然后使用Excel的QueryTable方法生成数据到Excel表指定位置,速度比较快
    代码如下::

    	Dim xlApp As New Excel.Application
        Dim xlQuery As Excel.QueryTable
        Dim xlSheet As Worksheet
        Dim SQL As String
        On Error GoTo Err_Cmd_QueryTable_Click
        '-------------------------------------
        ConnMDB
        If RS.State Then RS.Close
        Set xlApp = New Excel.Application    '初始化对象变量
        xlApp.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
        xlApp.Workbooks.Add          '增加一个工作薄
        xlApp.Sheets(xlApp.Sheets.Count).Name = "QueryTable技术导出记录集"  '修改工作薄名称
        Set xlSheet = xlApp.Worksheets("QueryTable技术导出记录集")
        SQL = "select * from student"
        Query2Excel SQL, Cnn, xlSheet, "A1", xlQuery 'A1即可将数据放到A1单元格
          '删除产生的连接
          Dim i As Long
        For i = xlSheet.Application.ActiveWorkbook.Connections.Count To 1 Step -1
            xlSheet.Application.ActiveWorkbook.Connections(i).Delete
        Next i
        xlApp.Visible = True
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlSheet = Nothing
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_QueryTable_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_QueryTable_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    

    其中ConnMDB及Query2Excel函数如下
    代码如下:

    Public Cnn As New ADODB.Connection
    Public RS As New ADODB.Recordset
    Public RStmp As New ADODB.Recordset
    Public FilePath As String
    '连接本地Access数据库
    Public Function ConnMDB() As Boolean
        Dim ConnStr As String
        If Cnn.State Then Cnn.Close
        ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=true;Persist Security Info=True;Data Source=" & App.Path & "\data.mdb"
        Cnn.CursorLocation = adUseClient
        Cnn.Open ConnStr
        If Cnn.State = 0 Then
            MsgBox "连接本地数据库失败,系统自动退出.", vbOKOnly + vbInformation, "信息提示"
        Else
            ConnMDB = True
        End If
    End Function
    '连接本地excel文件
    Public Function ConnExcel() As Boolean
        Dim ConnStr As String
        FilePath = "data.xls"
        If ExcelVer(FilePath) = 3 Then
            'excel 2003
            ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\" & FilePath & ";Extended Properties=""Excel 8.0;HDR=yes;IMEX=1"""
        Else
            'excel 2007,2010,2013,2016
            ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\" & FilePath & ";Extended Properties=""Excel 12.0;HDR=yes;IMEX=1"""
        End If
        If Cnn.State Then Cnn.Close
        Cnn.Open ConnStr
        If Cnn.State = 0 Then
            MsgBox "连接本地Excel失败,系统自动退出.", vbOKOnly + vbInformation, "信息提示"
        Else
            ConnExcel = True
        End If
    End Function
    Public Function Query2Excel(SQL As String, CN As ADODB.Connection, xlSheet As Excel.Worksheet, InsertPosition As String, xlQuery As Excel.QueryTable)
        If RStmp.State Then RStmp.Close
        RStmp.CursorLocation = adUseClient
        RStmp.Open SQL, CN, adOpenStatic, adLockReadOnly
        If RStmp.RecordCount < 1 Then
            Exit Function
        End If
        '添加查询语句,导入EXCEL数据
        Set xlQuery = xlSheet.QueryTables.Add(RStmp, xlSheet.Range(InsertPosition))
        With xlQuery
            .FieldNames = True
            .FieldNames = False    '是否显示字段名
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertEntireRows
            .SavePassword = True
            .SaveData = False
            .AdjustColumnWidth = False    '不需要列宽
            .RefreshPeriod = 0
            .PreserveColumnInfo = True
        End With
        xlQuery.Refresh
    End Function
    Public Function ExcelVer(ST As String) As Long
        Dim 后缀 As String
        后缀 = Mid(ST, InStrRev(ST, ".") + 1)
        ExcelVer = Len(后缀)
    End Function
    

    2.通过连接Access创建选择集,然后将选择集批量插入Excel指定位置,速度比较快
    代码如下:

        Dim xlApp As New Excel.Application
        Dim xlSheet As Worksheet
        Dim SQL As String
        On Error GoTo Err_Cmd_ADO_AccessDB_Click
        '-------------------------------------
        ConnMDB
        If RS.State Then RS.Close
        Set xlApp = New Excel.Application    '初始化对象变量
        xlApp.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
        xlApp.Workbooks.Add          '增加一个工作薄
        xlApp.Sheets(xlApp.Sheets.Count).Name = "连接Access导出数据实例"  '修改工作薄名称
        Set xlSheet = xlApp.Worksheets("连接Access导出数据实例")
        xlSheet.SaveAs App.Path & "\" & Format(Now, "yyyy-MM-dd-hh_mm_ss") & "学生表.xls"
        SQL = "select * from student"
        xlSheet.Cells(1, 1).CopyFromRecordset Cnn.Execute(SQL)
        Cnn.Close
        xlSheet.Application.ActiveWorkbook.Save
        xlApp.Visible = True
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlSheet = Nothing
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_ADO_AccessDB_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_ADO_AccessDB_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    

    3.通过连接Excel表,将Excel表作为数据库,创建选择集,然后将选择集批量插入Excel指定位置,速度比较快
    代码如下:

        Dim xlApp As New Excel.Application
        Dim xlSheet As Worksheet
        Dim SQL As String
        On Error GoTo Err_Cmd_ADO_ExcelDB_Click
        '-------------------------------------
        ConnExcel
        If RS.State Then RS.Close
        Set xlApp = New Excel.Application    '初始化对象变量
        xlApp.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
        xlApp.Workbooks.Add          '增加一个工作薄
        xlApp.Sheets(xlApp.Sheets.Count).Name = "Excel表格作为数据库导出数据实例"  '修改工作薄名称
        Set xlSheet = xlApp.Worksheets("Excel表格作为数据库导出数据实例")
    '    xlSheet.SaveAs App.Path & "\" & Format(Now, "yyyy-MM-dd-hh_mm_ss") & "学生表.xls"
        SQL = "select * from `学生记录$`"
        xlSheet.Cells(1, 1).CopyFromRecordset Cnn.Execute(SQL)
        Cnn.Close
    '    xlSheet.Application.ActiveWorkbook.Save
        xlApp.Visible = True
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlSheet = Nothing
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_ADO_ExcelDB_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_ADO_ExcelDB_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    

    4.将数组直接插入到Excel指定位置,速度比较快,因为数组数据在内存中,对于比较复杂的判断,可以先在数组中处理,可以用此种方法导出
    代码如下:

      Dim xlApp As New Excel.Application
        Dim xlSheet As Worksheet
        On Error GoTo Err_Cmd_From_Arr_Click
        '-------------------------------------
        ConnExcel
        If RS.State Then RS.Close
        Set xlApp = New Excel.Application    '初始化对象变量
        xlApp.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
        xlApp.Workbooks.Add          '增加一个工作薄
        xlApp.Sheets(xlApp.Sheets.Count).Name = "直接将内存中的数字复制到Excel实例"  '修改工作薄名称
        Set xlSheet = xlApp.Worksheets("直接将内存中的数字复制到Excel实例")
    
    
        Dim ArrData(10000, 10) As String
        For i = 1 To 10000
            For j = 1 To 10
                ArrData(i, j) = "第" & i & "行,第" & j & "列"
            Next j
        Next i
        xlSheet.Range("B2").Resize(UBound(ArrData, 1), UBound(ArrData, 2)) = ArrData'直接一句话搞定
        xlSheet.Cells.EntireColumn.AutoFit '自动调节列宽
        
        
        xlApp.Visible = True
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlSheet = Nothing
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_From_Arr_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_From_Arr_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    

    5.传统的方法,就是向Excel表格对应的单元格一个一个插入数据,此种方法是最原始的,也是最慢的
    代码如下:

     Dim xlApp As New Excel.Application
        Dim xlSheet As Worksheet
        On Error GoTo Err_Cmd_StandardMode_Click
        '-------------------------------------
        ConnExcel
        If RS.State Then RS.Close
        Set xlApp = New Excel.Application    '初始化对象变量
        xlApp.SheetsInNewWorkbook = 1  '将新建的工作薄数量设为1
        xlApp.Workbooks.Add          '增加一个工作薄
        xlApp.Sheets(xlApp.Sheets.Count).Name = "直接写入数据到Excel单元格实例"  '修改工作薄名称
        Set xlSheet = xlApp.Worksheets("直接写入数据到Excel单元格实例")
         Dim ArrData(100, 10) As String
        For i = 1 To 100
            For j = 1 To 10
                xlSheet.Cells(i + 1, j + 1) = "第" & i & "行,第" & j & "列"
            Next j
        Next i
        xlSheet.Cells.EntireColumn.AutoFit '自动调节列宽
        
        
        xlApp.Visible = True
        xlApp.Application.Visible = True
        Set xlApp = Nothing  '"交还控制给Excel
        Set xlSheet = Nothing
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_StandardMode_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_StandardMode_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    

    6.通过借助VSFlexGrid控件(一个相当相当好用的数据展示控件)的SaveGrid方法导出,导出过程瞬间完成,即使电脑上不安装Excel应用程序也没有问题。

    代码如下:

        Dim SQL As String
        Dim FilePath As String
        On Error GoTo Err_Cmd_VSFlexGrid2Excel_Click
        '-------------------------------------
        FilePath = App.Path & "\" & Format(Now, "yyyy-MM-dd-hh_mm_ss") & "借助VSFlexGrid导出Excel.xls"
        ConnMDB
        If RS.State Then RS.Close
        SQL = "select * from student"
        RS.Open SQL, Cnn, adOpenForwardOnly, adLockReadOnly
        Set VSFlexGrid1.DataSource = RS
        '导出数据
        VSFlexGrid1.SaveGrid FilePath, flexFileExcel, flexXLSaveFixedCells Or flexXLSaveRaw
        MsgBox "导出OK!"
        Shell "explorer " & FilePath   '打开excel表格
        '-------------------------------------
       On Error GoTo 0
       Exit Sub
    Err_Cmd_VSFlexGrid2Excel_Click:
       If MsgBox("【版本信息】:" & 版本 & vbCrLf & "【错误代码】:" & Err.Number & vbCrLf & "【错误描述】:" & Err.Description & vbCrLf & "【出错位置】: [Form1]→ [Cmd_VSFlexGrid2Excel_Click]的 " & Erl & "" & vbCrLf & "是否继续?", vbYesNo + vbQuestion + vbDefaultButton1, "错误处理") = vbYes Then Resume Next
    
    展开全文
  • vb.net中把datagridview的数据保存到excle,高效,快捷,简单!
  • 使用vb.net语言编写的excel文件数据读取和保存,可以实现读取数据的显示,希望大家可以多学习交流下。
  • vb6对excel的操作,创建,写入,读取,保存,删除 源码。 每个功能都是一小块。 调试可用,仔细看吧,对操作excel的朋友一定有用。 正常操作不会有资源为释放,进程一大堆exe的情况。 个人整理,10分,不求下载多
  • 如果是一般的打开某个Excel文件修改后保存到原文件或者新的文件,在 Excel.Application.Quit() 前直接使用 Workbook.Save() 或 Workbook.SaveAs(文件名称) 就可以了。 但是对于要把数据(并非通过打开Excel文件获得...

    版权声明:本文为博主原创文章,转载请在显著位置标明本文出处以及作者网名,未经作者允许不得用于商业目的。

    如果是一般的打开某个Excel文件修改后保存到原文件或者新的文件,在 Excel.Application.Quit() 前直接使用
    Workbook.Save() 或 Workbook.SaveAs(文件名称) 就可以了。
    但是对于要把数据(并非通过打开Excel文件获得的数据)保存成Excel文件,那么可以按照以下步骤:
    1、新建了一个Application对象:
    Dim xls As New Excel.Application
    2、新建工作簿并添加到创建的Application对象:
            Dim Wbook As Excel.Workbook
            Wbook = xls.Workbooks.Add
    3、  使用原有的工作表,一般默认创建Wbook后会有sheet1、sheet2、sheet3三个工作表,可以使用上一节方法指定一个工作表写数据。
    或者新建工作表:
           Dim Wsheet As Excel.Worksheet
            Wsheet = Wbook.Worksheets.Add
    并按需要指定工作表名称,如不指定,那么新工作表默认名称为 Sheet4:
            Wsheet.Name = "电脑销售表"
    4、读取现有数据并写入单元格,需要注意的是Excel单元格的起始序号为1,而一般vb.net中数组等的起始序号为0:
            Wsheet.Cells(i行号,列号).value = "值"
    5、保存工作簿
           Workbook.SaveAs(文件名称)
    6、最后,别忘了关闭打开的 Excel:
           Excel.Application.Quit()
    具体代码如下:

        '另存为
        Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
            Dim filename As String
            Dim sfd As New SaveFileDialog()
            sfd.Filter = "表格文件|*.xls;*.xlsx"
            If sfd.ShowDialog <> DialogResult.OK Then
                Exit Sub
            Else
                filename = sfd.FileName
            End If
    
            Dim xls As New Excel.Application
            Dim Wbook As Excel.Workbook
            Wbook = xls.Workbooks.Add
    
            Dim Wsheet As Excel.Worksheet
            Wsheet = Wbook.Worksheets.Add
            Wsheet.Name = "电脑销售表"
    
            If lvExcel.Columns.Count > 1 Then
                For i As Integer = 0 To lvExcel.Columns.Count - 1
                    Wsheet.Cells(1, i + 1).value = lvExcel.Columns(i).Text
                Next
            End If
    
            If lvExcel.Items.Count > 0 Then
                For i As Integer = 0 To lvExcel.Items.Count - 1
                    Dim pos As Integer = 0
                    For Each subLvText As ListViewItem.ListViewSubItem In lvExcel.Items(i).SubItems
                        pos += 1
                        If subLvText.Text = "(空)" Then
                            Wsheet.Cells(i + 2, pos).value = ""     '+2是因为excel表格第一行从1开始,而表头已经占了第一行,所以写入的数据从第2行开始。
                        Else
                            Wsheet.Cells(i + 2, pos).value = subLvText.Text
                        End If
                    Next
                Next
            End If
    
            Wbook.SaveAs(filename)
            xls.Quit()
    
            MessageBox.Show("保存完毕")
        End Sub

    保存的Excel文件如图:

     

    由于.net平台下C#和vb.NET很相似,本文也可以为C#爱好者提供参考。

    学习更多vb.net知识,请参看 vb.net 教程 目录

    展开全文
  • 但不是什么都能全自动化的,如果数据的输入都是excel,而且还要能方便的在所有人的机器上跑,那基于excelVB来实现一些简单数据处理也是非常方便的。 咳咳,扯远了。这章总结的是,如何从一个固定格式的工作表A,...

    问题背景

    如果一切数据都跑在后台,数据之间的迁移在全部自动化的情况下,无疑使用csv+python等处理更理想。但不是什么都能全自动化的,如果数据的输入都是excel,而且还要能方便的在所有人的机器上跑,那基于excel的VB来实现一些简单数据处理也是非常方便的。
    咳咳,扯远了。这章总结的是,如何从一个固定格式的工作表A,提取出想要的数据,按自己设定好的格式,写入另一个工作表B。

    设计思路

    1、需要掌握的技能

    1. 需要掌握获取文件路径、文件的打开和关闭等文件操作(实际实现时我都是ctrl+A全选然后ctrl+V贴到专门准备好的一个工作表里,怎么方便怎么来了)
    2. 需要知道怎么一行行/一列列地遍历指定工作表的有效数据,核心是,用For循环,循环条件是有效行的行号/列号
    3. 知道行号/列号,能方便的读写该行/列任意单元格的值
    4. 用IF ELSE对获取到的值进行条件处理

    2、实现逻辑

    1. For循环,遍历源文件A的标志数据列[A]
    2. IF条件检查[A]的值"aa"的有效性,满足条件则准备处理目标文件B
    3. For循环,遍历目标文件B的目标数据列[B]
    4. IF条件检查[B]的整列值里是否包含"aa",包含则按同类项累加,不包含则遍历结束后新增"aa"行
    5. 根据实际情况,步骤2和4会增加一定复杂度,但总体逻辑都可以拆分为1~4步骤的结合

    模块功能实现

    1. VBA文件路径获取、文件的打开、关闭
    Sub DemoFileOp()
    
    Dim WbookSrc
    
    paths = ThisWorkbook.Path & "\"        '获取当前路径
    Set WbookSrc = Workbooks.Open(paths & "Src.xlsx")  '打开源excel文件
    ......
    '关闭释放内存,否则高频操作excel会挂
    WbookSrc.Quit Save:=True  '保存excel
    Set WbookSrc = Nothing      '释放内存
    
    End Sub
    

    PS: 如果输入输出不是多个文件,一般来说手动复制源数据到工作表里会更方便。这个只是我一开始查到可以这么玩,实际操作把这块砍掉了。这里放着看以后有需要的时候再捡起来。

    1. VBA For循环对数据行/列遍历
    '****************************** 遍历行 ******************************
    Sub DemoForRow()
    
    Dim SrcRcdNum
    
    For SrcRcdNum = 2 To ThisWorkBook.Worksheets(1).Range("A65536").End(xlUp).Row  '遍历A列
       On Error Resume Next    '出了异常继续
       MsgBox Range("A" & SrcRcdNum)    '通过Range获取数据
       If ThisWorkbook.Worksheets(1).Range("A" & SrcRcdNum) = "aa"  Then    'For循环的条件退出
       	Exit For
       End If
    Next
    
    End Sub
    '****************************** 遍历列 ******************************
    Sub DemoForColumn()
    
    Dim SrcColNum
    
    For SrcColNum = 1 To ThisWorkbook.Worksheets(1).Range("AZ2").End(xlToLeft).Column  '遍历第2行
       If ThisWorkbook.Worksheets(1).Cells(2, SrcColNum) = "aa" Then   '列遍历使用Cells(行号,列号),避免数值和字母的转换
       	Exit For
       End If
    Next
    
    End Sub
    

    PS: VB的格式没有严格的缩进,但我觉得最好按python的习惯去写。

    1. 根据行号、列号获取单元格的值
    Range("A" & SrcRcdNum)    '通过Range获取数据,需要"A65535"这样的字符串表示的单元格
    Cells(2, SrcColNum)     '通过Cells获取数据,需要按(行号,列号)填充数据,如Cells(1,2)表示"B1"
    
    1. 用IF ELSE进行条件处理
    If "OK" = ThisWorkbook.Worksheets(1).Range("E" & SrcRcdNum) Then  
    	Flag = 1
    ElseIf "Pending" = ThisWorkbook.Worksheets(1).Range("E" & SrcRcdNum) Then
    	Flag = 2
    Else
    	Flag = 255
    End If
    

    PS: 对于多种情况的处理,比较清晰的方式是用标志位,等跳出循环后,再按标志位的值处理(扩展性好)。跳出循环时,行号列号仍是保留的。

    DEMO

    这里要实现的是,根据系统导出的昨日订单数据(每行源数据含订单号、产品编码、产品名称、订单状态、产品数量),生成产品每日销量表。

    Sub UpdateOrder()
    
    '定义VBA工作表操作相关的变量
    Dim SrcRcdNum
    Dim DstRcdNum
    Dim ExistFlag    
    
    '****************************** UpdateOrder ******************************
    '根据订单生成销售数据
    For SrcRcdNum = 2 To ThisWorkbook.Worksheets("昨日订单").Range("A65536").End(xlUp).Row  '遍历Src A列,所有订单号
    
    	'标志位清零
    	ExistFlag = 0
    	On Error Resume Next    '出了异常继续
    
    	For DstRcdNum = 2 To ThisWorkbook.Worksheets("生成数据").Range("A65536").End(xlUp).Row  '遍历Dst 产品编码列
    
    		If ThisWorkbook.Worksheets("昨日订单").Range("B" & SrcRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("A" & DstRcdNum) Then '产品编码相等,记下该行,跳出循环
    			ExistFlag = 1             '产品编码相等,flag = 1
    			Exit For 
    		End If
    	Next
    	
    	'根据flag标志进行目的文件更新
    	
    	'ExistFlag = 0, 产品编码不存在,全部新建数据
    	If ExistFlag = 0 Then
    		ThisWorkbook.Worksheets("生成数据").Range("A" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("B" & SrcRcdNum) '产品编码
    		ThisWorkbook.Worksheets("生成数据").Range("B" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("C" & SrcRcdNum) '产品名称
    		
    		'根据Cancelled判断是不是有效订单
    		If "Cancelled" <> ThisWorkbook.Worksheets("昨日订单").Range("D" & SrcRcdNum) Then  'Src D列,订单状态
    			ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) = ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum) 'Src E列,产品销售的数量
    		Else
    			ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) = 1 '取消订单的次数
    		End If
    	'ExistFlag = 1, 存在产品编码,累加数据
    	ElseIf ExistFlag = 1 Then
    		If "Cancelled" <> ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum) Then
    			ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("C" & DstRcdNum) + ThisWorkbook.Worksheets("昨日订单").Range("E" & SrcRcdNum)  '数量叠加
    		Else
    			ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) = ThisWorkbook.Worksheets("生成数据").Range("D" & DstRcdNum) + 1 '累加取消订单的次数
    		End If
    	End If
    
    Next
    
    End Sub
    

    扩展

    1.动态比较日期

    月度销量汇总的话,需要根据当前日期去匹配总表里的日期,才知道要更新哪列。
    在单元格Cells(2,2)设定值为=NOW(),再设置单元格格式为"3月14日",即忽略时分秒。
    实际比较中,NOW函数获取到的系统时间,整数位表示年月日,小数位表示时分秒,我们"ctrl+:"指定的日期是只有年月日的,在比较前需要对Cells(2,2)做取整处理。对了,时间虽然可以调格式显示成字符,实际应该仍是数值。
    在这里插入图片描述

    ...  '获取匹配今日的列号
    For DstRcdNum = 7 To ThisWorkbook.Worksheets(1).Range("AZ3").End(xlToLeft).Column  '遍历第3行,汇总表一般不超过1个月,AZ够了
    If ThisWorkbook.Worksheets(1).Cells(3, DstRcdNum) = Fix(ThisWorkbook.Worksheets(1).Cells(2, 3)) Then '比较日期,是否为今日
    TodayColumn = DstRcdNum
    Exit For
    End If
    Next
    ...
    

    2.条件格式高亮单元格

    当某日库存小于某个周期的销量时,最好能高亮该产品,以提醒发货。
    在这里插入图片描述
    找到条件格式新建一个规则,比较大小,满足条件则填充指定颜色即可。
    开始 - 样式 - 条件格式 - 新建规则
    按公式,选两个目标单元格比较,然后指定应用范围。
    在这里插入图片描述
    有时想按指定的行号高亮单元格,比如奇偶行高亮,每隔10行高亮等等,方便查看数据。
    可以按以下公式设置条件格式:

    公式:    =MOD(ROUNDUP((ROW()-1)/11,0),2)=1    #这里是每隔11行满足一次条件
    

    在这里插入图片描述
    MOD:取余函数,第一参数是除数,第二参数是被除数,这里套用奇偶行高亮规则,只要余数=1就高亮
    ROUNDUP:进一取整函数,第一参数是带小数的数,第二参数是要保留的小数位,第二参数取0,实现进一取整
    ROW:获取行号,第一行是标题,所以减1,我要按11行高亮,所以除以11
    效果如下:
    在这里插入图片描述

    3.动态获取周期范围的值

    诉求是能根据当前日期动态的获取7日销量的数据。
    由于这些数据都是显式呈现在excel上,只需要简单求和,难的是根据日期去匹配指定的列号。
    这个表是一个月备一次,1号到31号的列号其实是固定的。以1号为基准列号,可以根据今日日期的值减去1号的值得到今日日期和1号日期的列号差,用1号的基准列号加上这个差值就能得到今日数据所在的列号。

    假设F34是任意一个产品,I20是X月1号的日期,C2是=NOW()(当前日期)
    获取今日该产品销量所在单元格的值:
    =INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)))

    说明:Address获取某个产品的行号,列号由X月1号的列号加上列号差得到

    获取到1天,7日的就是逐级往左取值。

    =INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)))+IF(INT(C2-I20)-1>0, INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-1)), 0)+IF(INT(C2-I20)-2>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-2)), 0)+IF(INT(C2-I20)-3>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-3)), 0)+IF(INT(C2-I20)-4>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-4)), 0)+IF(INT(C2-I20)-5>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-5)), 0)+IF(INT(C2-I20)-6>0,INDIRECT(ADDRESS(CELL(“row”,F34),CELL(“col”,I20)+INT(C2-I20)-6)), 0)

    展开全文
  • Public Function ToExcel()On Error GoTo ErrorHandler Dim exlapp As Excel.ApplicationDim exlbook As Excel.WorkbookSet exlapp = CreateObject("Excel.Application")Set exlbook = exlapp.Workbooks....
    Public Function ToExcel()
    On Error GoTo ErrorHandler

    Dim exlapp As Excel.Application
    Dim exlbook As Excel.Workbook
    Set exlapp = CreateObject( "Excel.Application" )
    Set exlbook = exlapp.Workbooks.Add
    exlapp.Caption =
    "数据正在导出......"
    exlapp.Visible = True
    exlapp.DisplayAlerts = False

    Dim
    exlsheet As Excel.Worksheet

    Set exlsheet = exlbook.Worksheets.Add

    exlsheet.Activate
    Set exlsheet = exlsheet
    exlsheet.Name =
    "【我导出的数据】"

    '设置列宽
    exlapp.ActiveSheet.Columns( 1 ).ColumnWidth = 10

    exlapp.ActiveSheet.Columns( 2 ).ColumnWidth = 20


    StrSql = "【你的SQL语句】"

    Set exl_rs = PubSysCn.Execute(StrSql)

    exlsheet.Range(
    "A2" ).CopyFromRecordset exl_rs

    exl_rs.Close
    Set exl_rs = Nothing

    exlapp.Worksheets( "sheet1" ).Delete
    exlapp.Worksheets(
    "sheet2" ).Delete
    exlapp.Worksheets(
    "sheet3" ).Delete
    exlapp.DisplayAlerts =
    True
    exlapp.Caption = "数据导出完毕!!"
    exlapp.Visible = True

    Set
    exlapp = Nothing
    Set
    exlbook = Nothing
    Set
    exlsheet = Nothing

    Exit Function

    ErrorHandler:
    MsgBox
    "EXCEL : " & err.Number & " : " & err.Description
    End Function

     

    展开全文
  • 例如,您可以使用IncludeHeaders枚举的设置来指定标题是否保存数据。根据ExcelSaveFlags枚举使用ExcelSaveFlags.UseOOXMLFormat保存XLSX格式。在ExcelOpenFlags或ExcelSaveFlags内的文件缓存选...
  • VB6.0报表导出的实现一例,将内容导出到Excel中,或者导出Word文件中,在平时挺实用,不过代码只测试了下,可以用,核心代码如下: VERSION 5.00Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; ...
  • 利用VB控制Excel自动输入表格并且自动保存,刚朋友哪里拿的程序,自己还没看呢,拿出来跟大家一起分享,
  • VB6操作EXCEL导入数据库Private Function FunImpExcel(ByVal strFilePath As String) As Integer'Excel文件格式'第一行为表名,第二行为列名,其余行均为数据On Error GoTo hErrDim objConn As New ADODB.Connection...
  • 其实不算原创,论坛里有人发的,我正好项目写这里,缺的语句较多,无法运行,我补充了一下,可以简单的运行了,测试了一下,速度还不错。 VS2015可用,自己添加窗体和控件吧,只需要一个OpenFileDialog和Button,...
  • 注释:学习就是为了忘记,让我们来先来了解一下一种无需安装Microsoft Excel和.NET框架,直接用libxl操作Excel的方法吧… 目录 文章目录一、前言二、异常捕获流程图三、异常捕获语法四、异常类型速查表 一...
  • VB.NET DataGridView中的数据导入到Excel

    千次阅读 热门讨论 2012-02-04 14:31:19
    背景介绍:数据库里"卡信息表"中数据已成功在DataGridView1控件中...这里只介绍DataGridView控件中的数据是如何导入到Excel表中的。    操作步骤,主要谈谈需要注意的几点:  ① DataGridView1的"AllowUser
  •  在将dataGridView中的数据导出到excel时,网上找了一些相关的内容,个人感觉不是太好,有的在复杂了。  下面是简单的实现dataGridView数据到excel:  当然首先要添加引用:Microsoft.Office.Interop.Excel ...
  • VB将MSHFlexGrid中数据导出到Excel

    千次阅读 2013-09-28 11:27:48
    VB程序中,经查找筛选显示在MSHFlexGrid中的数据, '将查询的上机记录导入到excel表格中 If txtCardno.Text <> "" Then Dim tmpExcel As Excel.Application
  • 以下VB代码实现从datagridview导出数据到EXCEL,并以时间作为excel的文件名 Try Dim xlApp, xlBook, xlSheet As Object xlApp = CreateObject("Excel.Application") xlBook = xlApp.Workbooks.Ad
  • Public Enum ExportType  DiffrentData = 0  FirstData = 1  SecondData = 2 ...Public Function BuildSheet(ByRef xlSheet As Excel.Worksheet, ByVal strSQL As String, ByVal oType As Ex
  • vb.net datagridview实现数据导出Excel

    千次阅读 热门讨论 2015-03-20 19:25:14
    datagridview这一块的操作,对于我来说有些困难,先是从SQL server查询数据,在datagridview显示,再从datagridview删除字段,最后是现在的将datagridview的数据导出到Excel,这一个过程都显得有些困难,遇到困难...
  • vb.net datagridview控件导出excel

    千次阅读 热门讨论 2014-08-10 16:24:30
    导出数据的时候,经常需要将软件中的表格导出为excel,学习vb的时候用到了这个功能,当时用的是面向过程的编程方法,哪里需要了,就在哪个窗体写一遍代码。这次,我们使用面向对象的思维再次实现这个功能。对比一下...
  • 但是了学生充值记录查看和学生上机记录查询者两个窗体时就遇到了问题,首先是查询按钮,没有预先将MSFlexGrid表清空,导致查询数据时会出现重复的现象。然后是导出Excel表。这个是以前没有接触过的,所以在查了很...
  • 本文介绍C#及VB.NET程序代码来复制Excel中的指定单元格区域,包括复制单元格文本及单元格样式。复制时,可在工作簿中的同一个sheet工作表内复制,也可在不同工作簿的不同sheet工作表间复制。 程序环境:引用spire....
  • 这个文件是接着上一个,深化了一些,可以从excel中读出数据,写word的格式化好的表格中。可以帮助大家好好的利用代码操作word,生成的word文档保存在d盘根目录下 文章介绍: ...
  • 4.1 数据导出模板中 4.2 以日期命名并指定文件夹保存 4.3Excel在Web Browser控件中显示 五、打印EXCEL 5.1设置首选打印机 5.2新建“打印报表的表格” 5.3更新"生成报表"按钮 六、结束语 目录 一、概述 1.1 前言 在...
  • VB操作EXCEL表的常用方法

    万次阅读 多人点赞 2019-01-07 17:39:12
    VB是常用的应用软件开发工具之一...但由于VBEXCEL由于分别属于不同的应用系统,如何把它们有机地结合在一起,是一个值得我们研究的课题。 一、 VB读写EXCEL表: VB本身提自动化功能可以读写EXCEL表,其方法如下: ...
  • 利用VB操作Excel

    千次阅读 多人点赞 2019-02-13 09:50:17
    VB操作Excel详解 一、 VB读写EXCEL表: VB本身提自动化功能可以读写EXCEL表,其方法如下: 1、在工程中引用MicrosoftExcel 类型库: 从"工程"菜单中选择"引用"栏;选择Microsoft Excel ...
  •  Path = "C:\Users\WilliamDong\Dropbox\数据\EXCEL\" & companyname & ".xlsx"    If Dir(Path) <> "" Then    Set mydictionary = CreateObject("Scripting.Dictionary")  Set SourceBook = ...
  • VB对ACESS数据库的基本操作,适合新手,包括对数据库的添加,删除和修改,以及导出成EXCEL格式保存

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 3,639
精华内容 1,455
关键字:

vb保存数据到指定的excel