根据楼主实际数据,代码修改如下:
- Sub 提取农行数据()
- Dim brr(1 To 2000, 1 To 10)
- Application.ScreenUpdating = False
- [a2:j2000].ClearContents
- For Each sht In Worksheets(Array("办公人员TOP", "生产中心办-设备TOP", "仓库TOP", "品质TOP", "织造TOP", "染色TOP", "涂层TOP", "印花TOP"))
- arr = sht.[a1].CurrentRegion
- For i = 4 To UBound(arr) - 1
- If arr(i, 9) = "农行" Then
- n = n + 1
- brr(n, 1) = n: brr(n, 2) = arr(i, 2): brr(n, 3) = arr(i, 3): brr(n, 4) = arr(i, 4): brr(n, 5) = arr(i, 5)
- brr(n, 6) = arr(i, 7): brr(n, 7) = arr(i, 8): brr(n, 8) = arr(i, 9): brr(n, 9) = arr(i, 24): brr(n, 10) = arr(i, 25)
- End If
- Next
- Next
- If n = 0 Then
- MsgBox "没有找到有关信息!"
- Else
- With Sheets("农行")
- .Columns("F:G").NumberFormatLocal = "@"
- .[a2].Resize(n, 10) = brr
- End With
- End If
- Application.ScreenUpdating = False
- End Sub
复制代码 |