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