|
发表于 2016-6-1 16:45
|
显示全部楼层
本楼为最佳答案
- Sub 导入()
- Dim Sh As Worksheet
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- For i = 1 To Sheets.Count - 1
- Set Sh = Sheets(i)
- d(Sh.Name) = Sh.[b65536].End(3).Value '最大日期和工作表名的关联
- Next
- arr = Sheet6.[a1].CurrentRegion
- For i = 2 To UBound(arr)
- x = arr(i, 1): y = arr(i, 2)
- If y > d(x) Then d1(x) = d1(x) & "," & i
- Next
- For i = 1 To Sheets.Count - 1
- With Sheets(i)
- x = .Name
- r = .[a65536].End(3).Row: s = .Cells(r, 1) '最大行和计数
- If InStr(d1(x), ",") > 0 Then
- xrr = Split(d1(x), ",")
- ReDim brr(1 To UBound(xrr), 1 To 8)
- For k = 1 To UBound(xrr)
- j = xrr(k)
- brr(k, 1) = s + k
- brr(k, 2) = Day(arr(j, 2))
- brr(k, 7) = arr(j, 3)
- brr(k, 8) = arr(j, 4)
- Next
- .Cells(r + 1, 1).Resize(k - 1, 8) = brr
- End If
- End With
- Next
- End Sub
- Sub 清空()
- For i = 1 To Sheets.Count - 1
- Set Sh = Sheets(i)
- r = Sh.[e65536].End(3).Row
- Sh.Cells(r + 1, 1).Resize(1000, 8).ClearContents
- Next
- End Sub
复制代码 |
|