统计相同文件夹中不同工作表中有内容的行数

fzy587

统计相同文件夹中不同工作表中有内容的行数   谢谢！

fzy587

刚没添加上附件 补上

opiona

1.     Set SH0 = Sheets("统计")
   
2.     SH0.Range("A3:B65536").ClearContents
   
3.     INTX = 0
   
4.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
   
5.     For I = 0 To UBound(FileArr)
   
6.    
   
7.         Str_coon = "HDR=yes;imex=1';Data Source =" & FileArr(I)    '//OFFICE2003，2007 通用
   
8.         StrSQL = "SELECT COUNT(运单号) AS 个数 FROM [export$a:a] WHERE LEN(运单号)>0"
   
9.         SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
   
10.         SH0.Cells(I + 3, 1) = GetPathFromFileName(FileArr(I))
    
11.         SH0.Cells(I + 3, 2) = SQLARR(0, 0)
    
12.         INTX = INTX + SQLARR(0, 0)
    
13.     Next I
    
14.     LASTROW = SH0.Range("B65536").End(3).Row + 1
    
15.     SH0.Cells(LASTROW, 1) = "合计"
    
16.     SH0.Cells(LASTROW, 2) = INTX

复制代码

opiona

1.     Rem 在A列已经知道要那些文件的行数
   
2.     Set SH0 = Sheets("统计")
   
3.     FileArr = FileAllArr(ThisWorkbook.Path, "*.xls?", ThisWorkbook.Name, True, False)
   
4.     For IROW = 3 To SH0.Range("A65536").End(3).Row - 1
   
5.         For I = 0 To UBound(FileArr)
   
6.             If GetPathFromFileName(FileArr(I)) = SH0.Cells(IROW, 1) Then
   
7.                 Str_coon = "HDR=yes;imex=1';Data Source =" & FileArr(I)    '//OFFICE2003，2007 通用
   
8.                 StrSQL = "SELECT COUNT(运单号) AS 个数 FROM [export$a:a] WHERE LEN(运单号)>0"
   
9.                 SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
   
10.                 SH0.Cells(IROW, 2) = SQLARR(0, 0)
    
11.                 Exit For
    
12.             End If
    
13.         Next I
    
14.     Next IROW

复制代码

opiona

统计.rar (44.21 KB, 下载次数: 89)

2016-6-15 12:14 上传

点击文件名下载附件

两种统计方式都在里面

fzy587

opiona 发表于 2016-6-15 12:15
两种统计方式都在里面

用函数的可以做到吗？

weibamao

1. Sub 统计()
   
2. Dim s$, name$, c%, i%, wk As Workbook, rg As Range
   
3. s = ThisWorkbook.Path
   
4. name = Dir(s & "\*.xls")
   
5.     Do While name <> ""
   
6.         If name <> ThisWorkbook.name Then
   
7.             Set wk = Workbooks.Open(s & "" & name)
   
8.             c = [A65536].End(3).Row - 1
   
9.             ThisWorkbook.Sheets("统计").Activate
   
10.             i = Cells.Find(what:="合计").Row - 1
    
11.            
    
12.                 For Each rg In Range(Cells(3, 1), Cells(i, 1))
    
13.                     If rg.Value = Replace(name, ".xls", "") Then
    
14.                         rg.Offset(0, 1).Value = c
    
15.                     End If
    
16.                 Next
    
17.             wk.Close False
    
18.             
    
19.         End If
    
20.         name = Dir
    
21.     Loop
    
22. End Sub

复制代码

txswhm

学习了，好东西！

shaokui123

感谢分享，谢谢了