想请大神帮个忙，遍历提取和统计数据

anking2018

对每个文件的航班号，总重量进行提取；和对字段是PMC PLA的进行统计，小弟才疏现在只学会了遍历提取，还做不到更深的，请大神出手搭救。

anking2018

朱荣兴 发表于 2018-8-20 12:07
表格结构不完全相同，就有些麻烦，稍后看看再说吧

有大神罩着心里就定了很多

xiangbaoan

与你模拟的有区别，仅参考

anking2018

xiangbaoan 发表于 2018-8-20 13:30
与你模拟的有区别，仅参考

后面那个其实三个字符串也可以的

anking2018

xiangbaoan 发表于 2018-8-20 13:30
与你模拟的有区别，仅参考

我看了一下，是我模拟的数据写错了，谢谢大神

anking2018

xiangbaoan 发表于 2018-8-20 13:30
与你模拟的有区别，仅参考

遇到空行，这个需要怎么改一下

xiangbaoan

改下面的，在中间哟
ar = .[a1].CurrentRegion
为         
With .Worksheets(1)
ar = Intersect(.UsedRange, .[a:c])
End With

fsq119

1. Private Sub CommandButton1_Click()
   
2. Dim fil(), brr()
   
3. Application.ScreenUpdating = False
   
4. With Application.FileDialog(msoFileDialogFilePicker)
   
5.     .AllowMultiSelect = True
   
6.     .Filters.Clear
   
7.     .Filters.Add "excel", "*.xl*", 1
   
8.     .InitialFileName = ThisWorkbook.Path
   
9.     If .Show = -1 Then
   
10.         ReDim fil(1 To .SelectedItems.Count)
    
11.         For i = 1 To UBound(fil)
    
12.             fil(i) = .SelectedItems(i)
    
13.         Next
    
14.     End If
    
15. End With
    
16. ReDim brr(1 To UBound(fil), 1 To 10)
    
17. pat = [{"^PGA", "^PMC", "^FLA", "^PLA", "^ALF", "^AKE", "^BLKS"}]
    
18. Set reg = CreateObject("vbscript.regexp")
    
19. For i = 1 To UBound(fil)
    
20.     With Workbooks.Open(fil(i))
    
21.         brr(i, 1) = Mid(.Name, 1, InStr(.Name, ".") - 1)
    
22.         arr = .Sheets(1).[a1].CurrentRegion
    
23.         .Close savechanges:=False
    
24.     End With
    
25.     brr(i, 2) = arr(2, 3): brr(i, 10) = arr(3, 3)
    
26.     For j = 6 To UBound(arr)
    
27.         For k = 1 To UBound(pat)
    
28.             reg.Pattern = pat(k)
    
29.             If reg.test(arr(j, 2)) Then brr(i, k + 2) = brr(i, k + 2) + 1: Exit For
    
30.         Next k
    
31.     Next j
    
32. Next i
    
33. Cells(Cells.Rows.Count, 1).End(3).Offset(1, 0).Resize(UBound(brr), 10) = brr
    
34. Application.ScreenUpdating = True
    
35. End Sub

复制代码