- ©«¤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-8
|
¥»©«³Ì«á¥Ñ ã´£³¡ªL ©ó 2021-12-15 21:14 ½s¿è
¨S¸Ô²Ó¬Ýn§ì¤°»ò¼Æ¾Ú, ÀH«K¼g¤@ӰѦÒ, ¦Û¦æ¤F¸Ñµ{¦¡½X¦A®Ú¾Ú»Ý¨D§ï§ï:
Sub ½LÂI_´Áªì®w¦s()
Dim Arr, DD, PH$, FN1$, FN2$, FT$
Dim xB1 As Workbook, xS1 As Worksheet, xB2 As Workbook, xS2 As Worksheet
Dim xF1 As Range, xF2 As Range, TT$, DY
Application.ScreenUpdating = False
PH = ThisWorkbook.Path & "\"
FN2 = Range("B8")
If FN2 = "" Then MsgBox "«ü©wÀɦWºÙ¥¼¿é¤J! ": Exit Sub
FN2 = Dir(PH & FN2 & "*.xls*")
If FN2 = "" Then MsgBox "«ü©wÀɤ£¦s¦b! ": Exit Sub
'----------------------------------
FN1 = "¦h«È¤á½LÂIªí.xls"
On Error Resume Next: Set xB1 = Workbooks(FN1): On Error GoTo 0
If xB1 Is Nothing Then Set xB1 = Workbooks.Open(PH & FN1)
'-----------------------------------
On Error Resume Next: Set xB2 = Workbooks(FN2): On Error GoTo 0
If xB2 Is Nothing Then Set xB2 = Workbooks.Open(PH & FN2)
FT = Split(FN2, "Ü®w")(0) 'ºI¨ú[«È¤á]¦WºÙ
'-----------------------------------
ThisWorkbook.Activate
Set xS1 = xB1.Sheets("½LÂI")
DD = xS1.[e4]
Arr = Range(xS1.[di1], xS1.[a6536].End(3))
For i = 6 To UBound(Arr) Step 2
TT = Arr(i, 5) '«~¦W
DY = Day(DD + Arr(i, UBound(Arr, 2)) - 1) '¤é´Á--day..¥H di Äæ¨ú·í¤Ñ©Î«e¤@¤Ñ
If Arr(i, 1) <> FT Or TT = "" Then GoTo i01
On Error Resume Next: Set xS2 = xB2.Sheets(DY & ""): On Error GoTo 0
If xS2 Is Nothing Then GoTo i01
Set xF1 = xS2.Cells.Find("´Á¥½", Lookat:=xlWhole) '§ä[´Á¥½®w¦s]¦ì¸m
Set xF2 = xS2.[b:b].Find(TT, Lookat:=xlWhole) '§äBÄæ[«~¦W]¦ì¸m
If xF1 Is Nothing Or xF2 Is Nothing Then GoTo i01
xS1.Cells(i, 13) = xS2.Cells(xF2.Row, xF1.Column)
i01: Next i
MsgBox "´Áªì®w¦s¸ü¤J§¹¦¨, ¦h«È¤á½LÂIªí©|¥¼Àx¦s, Y½T©wµL»~¦A¤â°Ê¦sÀÉ! "
End Sub |
|