- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2023-12-27 12:17 編輯
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
執行前: 執行結果:
Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, sR As Range, eR As Range, xR As Range
With ActiveSheet.UsedRange
Intersect(.Offset(0, 7), .Offset(4, 0)).Delete Shift:=xlUp
End With
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([A1], [C5].End(xlDown)(2, 2))
For i = 1 To UBound(Brr)
If Trim(Brr(i, 1)) <> "" Or i = UBound(Brr) Then
Set sR = eR: Set eR = Cells(i, 1)
If Not sR Is Nothing Then
Z(sR & "") = Range(sR(1, 2), eR(0, 4))
Z(sR & "/r") = eR.Row - sR.Row
End If
End If
Next
Brr = Range([C35], [B65536].End(xlUp)): Set xR = [H5]
For i = 1 To UBound(Brr)
If Brr(i, 2) = "是" Then
With xR.Resize(Z(Brr(i, 1) & "/r"), 3)
.Value = Z(Brr(i, 1))
.Rows(1).Font.Bold = True
For j = 7 To 10: .Borders(j).Weight = 4: Next
End With
Set xR = xR(Z(Brr(i, 1) & "/r") + 1, 1)
End If
Next
End Sub
'==========================================================
以下是組別也帶入的方案
執行前: 執行結果:
Option Explicit
Sub TEST()
Dim 資料陣列, 到勤控制陣列, 字典, i&, j%, 起始格 As Range, 結束格 As Range, 結果起始格 As Range
With ActiveSheet.UsedRange
Intersect(.Offset(0, 7), .Offset(4, 0)).Delete Shift:=xlUp
End With
Set 字典 = CreateObject("Scripting.Dictionary")
資料陣列 = Range([A1], [C5].End(xlDown)(2, 2))
For i = 1 To UBound(資料陣列)
If Trim(資料陣列(i, 1)) <> "" Or i = UBound(資料陣列) Then
Set 起始格 = 結束格: Set 結束格 = Cells(i, 1)
If Not 起始格 Is Nothing Then
字典(起始格 & "") = Range(起始格(1, 1), 結束格(0, 4))
字典(起始格 & "/r") = 結束格.Row - 起始格.Row
End If
End If
Next
到勤控制陣列 = Range([C35], [B65536].End(xlUp)): Set 結果起始格 = [H5]
For i = 1 To UBound(到勤控制陣列)
If 到勤控制陣列(i, 2) = "是" Then
With 結果起始格.Resize(字典(到勤控制陣列(i, 1) & "/r"), 4)
.Value = 字典(到勤控制陣列(i, 1))
.Rows(1).Font.Bold = True
.Columns(1).Merge
For j = 7 To 10: .Borders(j).Weight = 4: Next
End With
Set 結果起始格 = 結果起始格(字典(到勤控制陣列(i, 1) & "/r") + 1, 1)
End If
Next
End Sub |
|
發表於 2023-12-27 09:59
| 