Lv,Gucci,Lv包包,Lv錢夾,Lv手錶,Lv目錄,Gucci公仔包,Lv購物包,Lv水桶包,Lv批發,愛美仕名牌購物

EXCEL VBA．將〔休假明細〕內容，填入〔月曆表〕相對位置
　　　　　　　　　　　　　　　　　　　　　　　＜．准提部林．＞
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
範例檔簡介：
■主要需求：
　１．Sheet1 為〔當月份〕的〔人員休假明細表〕。
　２．Sheet2 為〔月曆式〕的〔人員．日期對應表〕。
　３．在 Sheet2 的〔人員．日期〕的對應位置，
　　　填入〔休假時數〕，並將〔休假別〕設為〔註解〕。
　
■程式碼：
　Sub 更新本表()
　Dim uH As Range, xH1 As Range, xH2 As Range
　Dim Xm&, y&, Ym&, z&, Zm&, xR As Range, xT$, xDic As Object
　Set uH = Sheets("Sheet1").[A2]    '工作表１．〔人員〕第１格 
　Set xH1 = Sheets("Sheet2").[A2]  '工作表２．〔人員〕第１格 
　Set xH2 = Sheets("Sheet2").[B1]  '工作表２．〔日期〕第１格 
　'↑如果位置有變動，更改儲存格參照即可，下方程式皆依此為準 
　Xm = uH(65536 - uH.Row + 1, 1).End(xlUp).Row - uH.Row + 1
　'↑取得工作表１．〔人員〕列數 
　Ym = xH1(65536 - xH1.Row + 1, 1).End(xlUp).Row - xH1.Row + 1
　'↑取得工作表２．〔人員〕列數 
　Zm = xH2(1, 256 - xH2.Column + 1).End(xlToLeft).Column - xH2.Column + 1
　'↑取得工作表２．〔日期〕欄數 
　If Xm <= 0 Or Ym <= 0 Or Zm <= 0 Then Exit Sub
　'↑當上３項任一個無資料時，跳出不執行 
　'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
　Set xDic = CreateObject("Scripting.Dictionary")
　For Each xR In uH.Resize(Xm, 1)
　　　If xR <> "" And xR(1, 2) <> "" And xR(1, 3) <> "" And xR(1, 4) <> "" Then
　　　　'當〔人員．日期．事由．時數〕全有資料才處理 
　　　　xDic(xR & "_" & xR(1, 2)) = xR(1, 3) & "_" & xR(1, 4)
　　　　'收集資料：〔人員_日期〕為比對索引，〔事由_時數〕為對應資料 
　　　End If
　Next
　'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
　With xH2(2, 1).Resize(Ym, Zm): .ClearComments: .ClearContents: End With
　'↑清除原有〔時數．註解〕區 
　For y = 1 To Ym
　For z = 1 To Zm
　　　Set xR = xH2(y + 1, z)
　　　'↑要處理的儲存格 
　　　xT = xDic(xH1(y, 1) & "_" & xH2(1, z))
　　　'↑以〔人員_日期〕比對，取得對應資料 
　　　If xT <> "" Then
　　　　xR.NoteText Split(xT, "_")(0)
　　　　xR.Value = Split(xT, "_")(1)
　　　　With xR.Comment.Shape:  .Height = 18: .Width = 40:  End With
　　　　'↑設定〔註解框〕高與寬度 
　　　End If
　　　'↑如果有對應資料，將〔事由_時數〕分割成兩個值 
　　　'　第１個加為〔註解〕，第２個置入〔時數〕 
　Next: Next
　Beep
　End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
＜範例檔＞：
LV超3A名牌購物網