|
- Sub t()
- Dim arr, brr
- Dim i As Long, j As Long
- Dim lrow As Long, lcol As Long
- Dim tim1 As Date: tim1 = Timer
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Application.Calculation = xlManual
-
-
-
- With Sheets("计划")
- lrow = .Cells(Rows.Count, 3).End(3).Row
- lcol = .Cells(4, Columns.Count).End(1).Column
- arr = .Range("A1").Resize(lrow, lcol)
- End With
-
-
- Set dic = CreateObject("scripting.dictionary")
-
- Set dd = CreateObject("scripting.dictionary")
-
- For i = 1 To UBound(arr)
- arr(i, 2) = StrConv(arr(i, 2), vbNarrow)
-
- If InStr(arr(i, 2), "(") > 0 Then
- s = Replace(Split(arr(i, 2), "(")(1), ")", "")
- dic(s) = i
- If dd(s) = 0 Then dd(s) = dd.Count
- End If
-
- Next
- n = dic.Count
- ReDim brr(1 To n + 17, 1 To (UBound(arr, 2) - 4) * n + 4)
-
- For i = 1 To UBound(arr, 2) - 4
-
- brr(n + 1, 5 + n * (i - 1)) = arr(2, i + 4)
- brr(n + 2, 5 + n * (i - 1)) = arr(3, i + 4)
- brr(n + 3, 5 + n * (i - 1)) = arr(4, i + 4)
- For Each ky In dic.keys
-
- brr(n + 4, 5 + k) = ky
- For x = 1 To 13
- brr(n + 4 + x, 5 + k) = arr(dic(ky) + x - 1, i + 4)
- Next
-
- brr(dd(ky), 3) = ky
- brr(dd(ky), 4) = brr(n + 17, 5 + k) + brr(dd(ky), 4)
- k = k + 1
- Next
- Next
-
- brr(1, 2) = "月总计划"
- brr(n + 1, 3) = "日期"
- brr(n + 3, 3) = "部品番号"
-
-
-
- Sheets("模板").Cells.Clear
-
-
- With Sheets("模板").Range("A1")
-
- .Resize(UBound(brr), UBound(brr, 2)) = brr
-
- Sheets("计划").Range("B5:D17").Copy .Offset(n + 4, 1)
-
- .Offset(n + 4, 1) = ""
-
- .Offset(0, 1).Resize(n + 4).Merge
- .Offset(n, 2).Resize(2, 2).Merge
- .Offset(n + 2, 2).Resize(2, 2).Merge
-
- .Offset(n, 4).Resize(1, n * 2).Merge
- .Offset(n + 1, 4).Resize(1, n * 2).Merge
- .Offset(n + 2, 4).Resize(1, n).Merge
- .Offset(n + 2, 4 + n).Resize(1, n).Merge
-
- .Offset(0, 1).Resize(n + 17, 3).Borders.LineStyle = 1
- .Offset(0, 1).Resize(n + 17, 3).Borders.Weight = xlMedium
- .Offset(n, 4).Resize(17, n * 2).Borders.LineStyle = 1
- .Offset(n, 4).Resize(17, n * 2).Borders.Weight = xlMedium
- .Offset(n, 4).NumberFormatLocal = "m/d"
- .Offset(n, 4).Resize(17, n * 2).HorizontalAlignment = xlCenter
- .Offset(n + 4, 4).Resize(13, n * 2).NumberFormatLocal = "0;0;-"
-
-
- .Offset(n, 4).Resize(17, n * 2).Copy
- .Offset(n, 4 + n * 2).Resize(17, (UBound(arr, 2) - 4) * n - n * 2).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
- SkipBlanks:=False, Transpose:=False
- End With
-
- Application.Calculation = xlAutomatic
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
-
- MsgBox Format(Timer - tim1, "程序执行时间为:0.00秒"), 64, "时间统计"
-
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|