- ©«¤l
- 2827
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2883
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-10-27
|
¦^´_ 52# PJChen
Sub ½LÂI_«ü©w¤é¼Æ¶q_¸ü¤J()
Dim Arr, Brr, Crr(1 To 25), xD, i&, j%, k%
Dim xB As Workbook, xS As Worksheet, xNN$, vB As Workbook, vS As Worksheet, vNN$
Dim PH$, xN$, DD, D$(1), xF As Range
Application.ScreenUpdating = False
Set xD = CreateObject("Scripting.Dictionary")
PH = ThisWorkbook.Path & "\"
vNN = Range("B8")
If vNN = "" Then MsgBox "«ü©wÀɦWºÙ¥¼¿é¤J! ": Exit Sub
vNN = Dir(PH & vNN & "*.xls*")
If vNN = "" Then MsgBox "«ü©wÀɤ£¦s¦b! ": Exit Sub
'----------------------------------
xNN = "¦h«È¤á½LÂIªí.xls"
On Error Resume Next: Set xB = Workbooks(xNN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & xNN)
Set xS = xB.Sheets("½LÂI"): DD = CDate(xS.[e4])
D(0) = Day(DD - 1): D(1) = Day(DD)
Arr = Range(xS.[di1], xS.[a6536].End(3))
'-----------------------------------
On Error Resume Next: Set vB = Workbooks(vNN): On Error GoTo 0
If vB Is Nothing Then Set vB = Workbooks.Open(PH & vNN)
For k = 0 To 1
Set vS = vB.Sheets(D(k) & "")
Brr = vS.UsedRange
Set xF = vS.Cells.Find("½LÂI", Lookat:=xlWhole).MergeArea
For i = xF.Row + 2 To UBound(Brr) Step 2
If Brr(i, 2) = "" Then GoTo i01 '«~¦WªÅ¥Õ
For j = xF.Column To xF.Column + xF.Columns.Count - 1
xD(Brr(i, 2) & "|" & k & "|" & CLng(Brr(i, j))) = Brr(i + 1, j)
Next j
i01: Next i
Next k
vB.Close 0
'-----------------------------------
For i = 6 To UBound(Arr) Step 2
If InStr("/" & vNN, Arr(i, 1)) <> 2 Or Arr(i, 5) = "" Then GoTo i02 '«È¤á¦WºÙ¤ñ¹ï
For j = 1 To UBound(Crr)
Crr(j) = xD(Arr(i, 5) & "|" & Arr(i, UBound(Arr, 2)) & "|" & CLng(Arr(i, j + 59)))
Next j
xS.Cells(i + 1, 60).Resize(1, UBound(Crr)) = Crr: Erase Crr()
i02: Next i
xB.Activate: xS.Activate
Erase Arr, Brr: Set xD = Nothing: Set xB = Nothing: Set vB = Nothing: Set xS = Nothing: Set vS = Nothing
MsgBox "½LÂI¼Æ¶q¸ü¤J§¹¦¨, ¦h«È¤á½LÂIªí©|¥¼Àx¦s, Y½T©wµL»~¦A¤â°Ê¦sÀÉ! "
End Sub |
|