ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¹ïÀ³¤é´Á¶K½LÂI¸ê®Æ

¦^´_ 50# ­ã´£³¡ªL

ÁÂÁ ·Ç¤j ¤p§Ì¬ã¨s¤@¤U ·PÁÂ

TOP

¦^´_ 50# ­ã´£³¡ªL

­ã¤j¦n,

1) FT = Split(FN2, "®w¦sªí")(0)
«È¤áÀɦW¤j¦h¥HXXX®w¦sªí ©R¦W

¦ýFT = Split(FN2, "®w¦sªí")(0) 'ºI¨ú[«È¤á]¦WºÙ
³o¸Ì¬O¥Î³Ì¤j¦h¼Æªº"®w¦sªí"¨Ó¤ÀÂ÷¦r¦ê
¦ý¦]¬°¦P¤@«È¤á¦³¤£¦P¼t§O,
¨Ò¦p¡G¨Î¨Î¤¤Ãc¼t®w¦sªí
¦b[B8]·|¿é¤J"¨Î¨Î¤¤Ãc¼t®w¦sªí"
³o¼Ë¤S·|§ì¤£¨ìÀÉ®×
½Ð°Ý¦p¦ó­×§ï?
FT = Split(FN2, "®w¦sªí")(0)

2)
±Nµ{¦¡§ï¬°§ì¨ú½LÂI¸ê®Æ®É,
Áٻݭn¥[¤J¤@¬q¤ñ¹ï¤é´Áªºµ{¦¡
¤ñ¹ï³W«h
«È¤á®w¦sªíªº²Ä7¦C,¹ïÀ³"¦h«È¤á½LÂIªí"ªº²Ä6¦C
½Ð°Ý¥H¤Uµ{¦¡­n«ç»ò­×§ï?
    Set xF1 = xS2.Cells.Find("½LÂI", Lookat:=xlWhole) '§ä«È¤á[½LÂI]¦ì¸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, 60) = xS2.Cells(xF2.Row, xF1.Column) '¦h«È¤á½LÂIÄæ=60

TOP

¦^´_ 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

TOP

¦^´_ 53# ­ã´£³¡ªL
­ã¤j¦n,

´ú¸Õ¦h¤é,´Áªì&½LÂI¸ê®Æ,³£¥¿½T...
·PÁ¡I

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD