返回列表 上一主題 發帖

[發問] 請問這個巨集如何改進

回復 7# pcwh3
  1. Sub WHREPORT()
  2. Dim Rng As Range, A As Range, i%, k%
  3. With ActiveSheet
  4. st = .[A6]
  5. d = Day(DateAdd("M", 1, st) - 1)
  6. Set Rng = .Range("A6", .[A65536].End(xlUp)).SpecialCells(xlCellTypeBlanks)
  7. Rng.Areas(2)(1).Offset(, 1).Resize(2, 16) = ""
  8. Rng.Areas(1)(1).Offset(, 1).Resize(, 15).FormulaArray = "=COLUMN(A1:O1)"
  9. Rng.Areas(1)(1).Offset(1, 1).Resize(, 15).FormulaR1C1 = "=UPPER(TEXT(TEXT(R6C1,""yyyy/mm/"")&R[-1]C,""ddd""))"
  10. Rng.Areas(1)(1).Offset(, 1).Resize(2, 15) = Rng.Areas(1)(1).Offset(, 1).Resize(2, 15).Value
  11. Rng.Areas(2)(1).Offset(1, 1).Resize(, d - 15).FormulaR1C1 = "=UPPER(TEXT(TEXT(R6C1,""yyyy/mm/"")&R[-1]C,""ddd""))"
  12. Rng.Areas(2)(1).Offset(, 1).Resize(, d - 15).FormulaArray = "=TRANSPOSE(ROW(A16:A" & d & "))"
  13. Rng.Areas(2)(1).Offset(, 1).Resize(2, d - 15) = Rng.Areas(2)(1).Offset(, 1).Resize(2, d - 15).Value
  14. k = Rng.Areas(2).Row - Rng.Areas(1).Row
  15. For i = 1 To 2
  16. For Each A In Rng.Areas(i)(1).Offset(1, 1).Resize(, 15)
  17.    If A = "MON" Then
  18.    A.Offset(-1, 0).Resize(k, 1).Interior.ColorIndex = 6
  19.    Else
  20.    A.Offset(-1, 0).Resize(k, 1).Interior.ColorIndex = -4142
  21.    End If
  22. Next
  23. Next
  24. End With
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 願要大、志要堅、氣要柔、心要細。
返回列表 上一主題