楼主
wjc2090742 |
Q：如何按困难类型汇总登记表？按地点填写的困难登记表，要求按照困难的类型，将多表汇总为新工作簿中3个工作表，并引用相关数据。
A：- Sub tt()
- On Error Resume Next
- Dim i%, arr(), ar1(), ar2(), ar3(), k&
- m = 0: n = 0: o = 0
- For i = 1 To Sheets.Count
- With Sheets(i)
- arr = .[a4].Resize(.Cells(.Rows.Count, 1).End(3).Row - 3, 10).Value
- For k = 3 To UBound(arr, 1)
- If arr(k, 5) > 0 Then
- m = m + 1
- ReDim Preserve ar1(1 To 9, 1 To m)
- ar1(1, m) = m
- ar1(2, m) = arr(k, 3)
- ar1(5, m) = arr(k, 4)
- ar1(6, m) = .[b3]
- ar1(7, m) = arr(k, 5)
- ar1(8, m) = arr(k, 8)
- End If
- If arr(k, 6) > 0 Then
- n = n + 1
- ReDim Preserve ar2(1 To 9, 1 To n)
- ar2(1, n) = n
- ar2(2, n) = arr(k, 3)
- ar2(5, n) = arr(k, 4)
- ar2(6, n) = .[b3]
- ar2(7, n) = arr(k, 6)
- ar2(8, n) = arr(k, 8)
- End If
- If arr(k, 7) > 0 Then
- o = o + 1
- ReDim Preserve ar3(1 To 9, 1 To o)
- ar3(1, o) = o
- ar3(2, o) = arr(k, 3)
- ar3(5, o) = arr(k, 4)
- ar3(6, o) = .[b3]
- ar3(7, o) = arr(k, 7)
- ar3(8, o) = arr(k, 8)
- End If
- Next
- End With
- Next
- Workbooks.Open (ThisWorkbook.Path & "\" & "表2.xls")
- With ActiveWorkbook
- .Sheets("医疗救助").Range("a7").Resize(UBound(ar1, 2), 9) = WorksheetFunction.Transpose(ar1)
- .Sheets("意外事故").Range("a7").Resize(UBound(ar2, 2), 9) = WorksheetFunction.Transpose(ar2)
- .Sheets("生活致困").Range("a7").Resize(UBound(ar3, 2), 9) = WorksheetFunction.Transpose(ar3)
- .Close True
- End With
- End Sub
 问题.rar
|