zoukankan      html  css  js  c++  java
  • vba实践

    1、查询满足条件的单元格行数 | 单元格汇总到本表

    案例背景:
    文件夹中有很多公司的每天市值信息,一张表格一家公司,有日期,当日市值等
    查询某个日期的市值,并汇总到一张表格中
    汇总表中有当日所有公司的市值信息
     
    Sub 市值汇总表()
        Dim findDate As String
        Dim a As Integer
        findDate = "2018/8/15"
        a = 1
        Application.ScreenUpdating = False
        myfile = Dir(ThisWorkbook.Path & "*.xls*")
        ThisWorkbook.Worksheets(1).Cells(1, 1) = "文件名称"
        ThisWorkbook.Worksheets(1).Cells(1, 2) = "简称"
        ThisWorkbook.Worksheets(1).Cells(1, 3) = findDate & "市值"
        Do While myfile <> ""
               If myfile <> ThisWorkbook.Name Then
                    Set wb = Workbooks.Open(ThisWorkbook.Path & "" & myfile)
                    a = a + 1
                    Set aftersheet = wb.ActiveSheet.Range("C:C")
                    aftersheet.NumberFormat = "yyyy/m/d"
                    Set findRange = aftersheet.Find(DateValue(findDate))
                    ThisWorkbook.Worksheets(1).Cells(a, 1) = myfile '文件名称即代码
                    ThisWorkbook.Worksheets(1).Cells(a, 2) = wb.ActiveSheet.Range("b2") '公司简称
                    If Not findRange Is Nothing Then
                        ThisWorkbook.Worksheets(1).Cells(a, 3) = wb.ActiveSheet.Range("N" & findRange.Row) '当日市值
                    Else
                        ThisWorkbook.Worksheets(1).Cells(a, 3) = "无当日市值" '当日市值
                    End If
                    wb.Close False
                End If
            myfile = Dir
        Loop
        Application.ScreenUpdating = True
        MsgBox "完成"
    End Sub

    2、复制每个excel第二行并汇总

    案例背景:

    基本情况同一

    此处需要汇总所有excel第二行的信息,即每家公司的开市情况

    汇总表中是所有公司的开市情况

    Sub 第二行汇总()
        Dim findDate As String
        Dim a As Integer
        findDate = "2018/8/15"
        a = 1
        Application.ScreenUpdating = False
        myfile = Dir(ThisWorkbook.Path & "*.xls*")
        Do While myfile <> ""
               If myfile <> ThisWorkbook.Name Then
                    Set wb = Workbooks.Open(ThisWorkbook.Path & "" & myfile)
                    a = a + 1
                    wb.ActiveSheet.Rows(2).Copy
                    wb.Close False
                End If
            myfile = Dir
        Loop
        Application.ScreenUpdating = True
        MsgBox "完成"
    End Sub
    Sub test()
        Dim mainRowNo As Integer
        Dim days As Long
        Dim startdaterowno As Long
        Dim totalrow As Long
        Dim activeEnd As Long
        days = 120
        Application.ScreenUpdating = False
        myfile = Dir(ThisWorkbook.Path & "*.xls*")
        Do While myfile <> ""
             If myfile <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(ThisWorkbook.Path & "" & myfile)
                For mainRowNo = 3 To 48
                    Set Start = ThisWorkbook.ActiveSheet.Range("E" & mainRowNo) '开始日期
                    Set EndDate = ThisWorkbook.ActiveSheet.Range("o" & mainRowNo)   '结束日期
                    'Start.NumberFormat = "yyyy/m/d"
                    'EndDate.NumberFormat = "yyyy/m/d"
                    Set aftersheet = wb.ActiveSheet.Range("C:C")
                    aftersheet.NumberFormat = "yyyy/m/d"
                    Set startno = aftersheet.Find(Start) '开始日期的位置
                    Set enddateno = aftersheet.Find(EndDate) '结束日期的位置
                    startdaterowno = startno.Row - days  '往前推120天的位置
                    totalrow = enddateno.Row - startno.Row
                    wb.Sheets.Add after:=ActiveSheet
                    ActiveSheet.Name = mainRowNo
                    activeEnd = totalrow + 1
                    wb.Sheet1.Range("c" & startdaterowno & ":c" & enddateno).Copy Destination:=wb.ActiveSheet.Range("c2:c" & activeEnd)
                    
                Next mainRowNo
             End If
        Loop
         
    End Sub
    Sub test()
        Dim mainRowNo As Integer
        Dim days As Long
        Dim startdaterowno As Long
        Dim totalrow As Long
        Dim activeEnd As Long
        Dim Start, endDate, aftersheet, startno, enddateno, wb
        days = 120
        Application.ScreenUpdating = False
        myfile = Dir(ThisWorkbook.Path & "*.xls*")
        Do While myfile <> ""
             If myfile <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(ThisWorkbook.Path & "" & myfile)
                For mainRowNo = 3 To 48
                    Set Start = ThisWorkbook.ActiveSheet.Range("E" & mainRowNo) '开始日期
                    Set endDate = ThisWorkbook.ActiveSheet.Range("o" & mainRowNo)   '结束日期
                    'Start.NumberFormat = "yyyy/m/d"
                    'EndDate.NumberFormat = "yyyy/m/d"
                    Set aftersheet = wb.ActiveSheet.Range("C:C")
                    aftersheet.NumberFormat = "yyyy/m/d"
                    Set startno = aftersheet.Find(Start) '开始日期的位置
                    Set enddateno = aftersheet.Find(endDate) '结束日期的位置
                    startdaterowno = startno.Row - days  '往前推120天的位置
                    totalrow = enddateno.Row - startno.Row
                    wb.Sheets.Add after:=ActiveSheet
                    ActiveSheet.Name = mainRowNo
                    activeEnd = totalrow + 1
                    wb.Sheet1.Range("c" & startdaterowno & ":c" & enddateno).Copy Destination:=wb.ActiveSheet.Range("c2:c" & activeEnd)
                    
                Next mainRowNo
             End If
        Loop
    End Sub
  • 相关阅读:
    python各种类型转换-int,str,char,float,ord,hex,oct等
    pandas快速入门
    python里面,将多个list列表合并成一个list列表
    对字符串进行切分的技巧
    Ubuntu 16.04 安装navicat (tar.gz)
    ubuntu 16.04 如何升级系统的scrapy旧版本(1.0.3)到最新版本
    ubuntu下,敲命令scrapy出现:0: UserWarning: You do not have a working installation of the service_identity module: 'cannot import name 'opentype''. Please install it from <https://pypi.python.org/pypi/servic
    Ubuntu下解压缩zip,tar,tar.gz,tar.bz2格式的文件
    简单的查看进程信息
    python正则表达式
  • 原文地址:https://www.cnblogs.com/mgblog/p/13219266.html
Copyright © 2011-2022 走看看