- ©«¤l
- 471
- ¥DÃD
- 121
- ºëµØ
- 0
- ¿n¤À
- 579
- ÂI¦W
- 0
- §@·~¨t²Î
- WIN10
- ³nÅ骩¥»
- OFFICE2019
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2015-4-16
- ³Ì«áµn¿ý
- 2023-1-17
|
¥»©«³Ì«á¥Ñ starry1314 ©ó 2015-6-6 01:36 ½s¿è
¦^´_ 8# luhpro
¯u¬O¤Ó·PÁÂÀ°¦£¤F~¸Ñ¨M±¼§Ú¦n´XÓ§xÂZªº°ÝÃD
¤w¥¿±`¹B§@ ,¦ý¬õ¦r³¡¤À¦³ÂI¤¾ªø,¥iÀ°¦£°µÀu¤Æ¶Ü?
¦]¨S¥[Windows("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Activate
Sheets("¤@¤ë").Select
·|¦b쥻¶±°µ¶K¤W¸ê®Æªº°Ê§@
¥t·Q½Ð°Ý¤@¶}©lµ¹§Úªº
sPath = ThisWorkbook.Path
ChDrive sPath
ChDir sPath
§@¥Î¬O? ¦]¥ÎºÊ¬Ý¦¡¬Ý¤£À´,¹Á¸Õ§â¥L®³±¼ÁÙ¬O¥¿±`¹B§@
Sub ¶K¤W¸ê®Æ()
'
Dim lSourceRow As Long, lTargetRow As Long
Dim wsTarget As Worksheet
With ActiveSheet
lSourceRow = Selection(1).Row '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
' If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "¤é´ÁÄæµL¸ê®Æ¡AµLªk§PÂ_¶K¤W¤ë¥÷": Exit Sub
'Set wsTarget = Workbooks("«È¤á©ú²Ó-·~°È±M¥Î.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '¤é´Á§PÂ_n¶K¤Wªº¤u§@ªí
Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets(.cells("¤@¤ë")
Windows("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Activate
Sheets("¤@¤ë").Select
lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1 'n¶K¤Wªº¦ì¸m
Application.ScreenUpdating = False
.Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "AF")).Copy '½Æ»sAÄæ¨ìPÄ檺¸ê®Æ
wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W
wsTarget.Paste Link:=True '¶K¤W³sµ²
Application.ScreenUpdating = True '¶K¤W³sµ²
End With
With wsTarget
.Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
Address:=ThisWorkbook.FullName, _
SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
TextToDisplay:=.Cells(lTargetRow, "a").Text
End With
End Sub |
|