- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 1# 520iopiop
將檔案放在壓縮檔可上傳
試試看- Option Explicit
- Sub Ex()
- Dim Sh(1 To 2) As Worksheet, Rng(1 To 3) As Range, CRng(1 To 2) As Range
- Dim i As Integer, R As Integer, C As Integer
- Set Sh(1) = Sheets("Sheet1") '資料表
- Set Sh(2) = Sheets("Sheet2") '呈現表
- Set Rng(1) = Sh(1).Range("i3:j3") '課程起日~課程迄日
- Set Rng(2) = Sh(2).Range("c4") '排程開始日期
-
- Set CRng(1) = Sh(1).Range("M2:S2") '上課星期
- Set CRng(2) = Sh(2).Range("b5", Sh(2).Range("b5").End(xlDown)) '上課時間
-
- Rng(2).Offset(1).Resize(CRng(2).Rows.Count, 7) = "" '清除呈現表
-
- Do While Rng(1).Cells(1) <> "" '課程起日<>""
- i = 0 '排程開始日期的欄位
- Do While Rng(2).Offset(, i) >= Rng(1).Cells(1) And Rng(2).Offset(, i) <= Rng(1).Cells(2)
- '迴圈的條件:呈現表的日期是[課程起日~課程迄日]的期間
- C = CRng(1).Cells(Application.Match(Format(Rng(2).Offset(, i), "AAAA"), CRng(1), 0)).Column
- 'C = 資料表的上課星期中搜尋,排程日期的星期欄數
- Set Rng(3) = Sh(1).Cells(Rng(1).Row, C) '資料表的上課的時間區段
- If Rng(3) <> "" Then
- R = Application.Match(Rng(3), CRng(2), 1)
- 'R=列數:呈現表的上課的時間中所對應的,資料表的上課的時間
- Rng(2).Offset(R, i) = IIf(Rng(2).Offset(R, i) = "", Sh(1).Cells(Rng(1).Row, "B"), Rng(2).Offset(R, i) & vbLf & Sh(1).Cells(Rng(1).Row, "B"))
- '排程開始日期(R列, i欄)
- 'Sh(1).Cells(Rng(1).Row, "B") =>資料表的學員編號
- End If
- i = i + 1 'Rng(2).Offset(, i)->排程開始日期的欄位,向右移動一欄
- Loop
- Set Rng(1) = Rng(1).Offset(1) '課程起日,向下移動一列
- Loop
- CRng(2).EntireRow.AutoFit
- End Sub
|
|
發表於 2014-10-3 16:09
| 