混凝土强度报告的汇总，怎么把很多份强度报告中我需要的信息提取出来，并汇总到汇...

被枫带走的记忆

lsc900707 发表于 2016-8-30 10:14
你要把数据汇总这个工作簿放在你的汇总文件夹里才行呀，汇总前先清除所汇总的内容再点击按钮。>>>>>>>

还请教一下，这个[G4],6,20是什么意思啊

1. Sub 汇总()
   
2. Dim wb As Workbook, myfile$, s&
   
3. Application.ScreenUpdating = False
   
4. myfile = Dir(ThisWorkbook.Path & "\1" & "\*.xls")
   
5. s = 1
   
6. Do While myfile <> ""
   
7.         s = s + 1
   
8.         Set wb = GetObject(ThisWorkbook.Path & "\1" & myfile)
   
9.         With wb.Sheets(2)
   
10.             Cells(s + 2, 1) = Mid(.[G4], 6, 20) & .[K4]
    
11.             Cells(s + 2, 2) = .[C5]
    
12.             Cells(s + 2, 3) = .[C12]
    
13.             Cells(s + 2, 4) = .[B12]
    
14.             Cells(s + 2, 8) = .[D12]
    
15.             Cells(s + 2, 9) = .[K12]
    
16.         End With
    
17.         wb.Close False
    
18.     myfile = Dir
    
19. Loop
    
20. Application.ScreenUpdating = True
    
21. 
    
22. End Sub
    

复制代码

LMY123

被枫带走的记忆 发表于 2016-8-30 17:09
还请教一下，这个[G4],6,20是什么意思啊

Mid(.[G4], 6, 20),从G4单元格第6个字符开始，向右取20个字符

被枫带走的记忆

LMY123 发表于 2016-8-30 17:28
Mid(.[G4], 6, 20),从G4单元格第6个字符开始，向右取20个字符

哦，知道了，谢谢哈

LMY123

1. Sub ADO加数组复习()
   
2.   t = Timer
   
3.   Dim Fso As Object, File As Object, cnn As Object, rs As Object, SQL$, m&, arr()
   
4.   Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.   ReDim arr(1 To Fso.GetFolder(ThisWorkbook.Path & "\混凝土报告").Files.Count, 1 To 12)
   
6.   For Each File In Fso.GetFolder(ThisWorkbook.Path & "\混凝土报告").Files
   
7.   If File.Name Like "*.xls" Then
   
8.     m = m + 1
   
9.     Set cnn = CreateObject("ADODB.Connection")
   
10.     cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & File
    
11.     Set rs = cnn.Execute("[1$G4:K4]")
    
12.     arr(m, 1) = Mid(rs.Fields(0), 6, 20) & rs.Fields(4)
    
13.     Set rs = cnn.Execute("[1$C5:C5]")
    
14.     arr(m, 2) = rs.Fields(0)
    
15.     Set rs = cnn.Execute("[1$B12:K12]")
    
16.     arr(m, 3) = rs.Fields(1)
    
17.     arr(m, 4) = rs.Fields(0)
    
18.     arr(m, 8) = rs.Fields(2)
    
19.     arr(m, 9) = rs.Fields(9)
    
20.   End If
    
21.   Next
    
22.   ActiveSheet.UsedRange.Offset(3).ClearContents
    
23.   If m > 0 Then [a4].Resize(m, 12) = arr
    
24.   rs.Close
    
25.   cnn.Close
    
26.   Set rs = Nothing
    
27.   Set cnn = Nothing
    
28.   Set Fso = Nothing
    
29.   MsgBox Timer - t
    
30. End Sub

复制代码