[µo°Ý] Ãö©ó¦Û°Ê¶}±Ò«ü©w¦ì¸mÀÉ®×or¶W³sµ²¸ô®|ªºÀÉ®×

starry1314

¦p¦ó¥[¤J¥H¤U«ü¥O©O? ¦]§Ú¥[¶iDim wsTarget As Worksheet
©³¤U ¦n¹³·|³y¦¨«ö¶s¦æ¤£¹ï ©Ò¥H¨S¿ìªk§PÂ_~
©Î¬O­n«ç»ò³]©w¦¨«ü©w¸ô®|µM«áÀɦW,¥i¥HŪ¨úÀx¦s®æªºÀɦW°µÅܼƩO?

¥h¼Æ¾Úªí®æ ÂI¿ïB22ªº¶W³sµ² ¶}±Ò«È¤á©ú²Ó
  Sheets("¼Æ¾Ú").Select
    Range("B22").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

1. Sub ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z_¦Û°Ê§PÂ_()
   
2. '
   
3. ' ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z ¥¨¶°
   
4.     Dim lSourceRow As Long, lTargetRow As Long
   
5.     Dim wsTarget As Worksheet
   
6.     With ActiveSheet
   
7.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
   
8.         If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "¤é´ÁÄæµL¸ê®Æ¡AµLªk§PÂ_¶K¤W¤ë¥÷": Exit Sub
   
9.         Set wsTarget = Workbooks("«È¤á©ú²Ó-·~°È±M¥Î.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '¤é´Á§PÂ_­n¶K¤Wªº¤u§@ªí
   
10.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '­n¶K¤Wªº¦ì¸m
    
11.         Application.ScreenUpdating = False
    
12.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "P")).Copy '½Æ»sAÄæ¨ìPÄ檺¸ê®Æ
    
13.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W
    
14.         wsTarget.Paste Link:=True '¶K¤W³sµ²
    
15.         Application.ScreenUpdating = True '¶K¤W³sµ²
    
16.     End With
    
17.    
    
18.     With wsTarget
    
19.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
    
20.                         Address:=ThisWorkbook.FullName, _
    
21.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
    
22.                      TextToDisplay:=.Cells(lTargetRow, "a").Text
    
23. 
    
24.     End With
    
25. End Sub

½Æ»s¥N½X

starry1314

¤w¥[¤J ¦ý·|¸õ¥X °õ¦æµ{»Ý©Î©I¥s¿ù»~

¤U¸ü (27.41 KB)

2015-6-4 15:47

1. Sub ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z_¦Û°Ê§PÂ_()
   
2. '
   
3. ' ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z ¥¨¶°
   
4.     Dim lSourceRow As Long, lTargetRow As Long
   
5.     Dim wsTarget As Worksheet
   
6.     Dim sPath$
   
7. 
   
8. sPath = ThisWorkbook.Path
   
9. ChDrive sPath
   
10. ChDir sPath
    
11.     With ActiveSheet
    
12.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
    
13.         If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "¤é´ÁÄæµL¸ê®Æ¡AµLªk§PÂ_¶K¤W¤ë¥÷": Exit Sub
    
14.         Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '¤é´Á§PÂ_­n¶K¤Wªº¤u§@ªí
    
15.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '­n¶K¤Wªº¦ì¸m
    
16.         Application.ScreenUpdating = False
    
17.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "AF")).Copy '½Æ»sAÄæ¨ìPÄ檺¸ê®Æ
    
18.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W
    
19.        wsTarget.Paste Link:=True '¶K¤W³sµ²
    
20.         Application.ScreenUpdating = True '¶K¤W³sµ²
    
21.     End With
    
22.    
    
23.     With wsTarget
    
24.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
    
25.                         Address:=ThisWorkbook.FullName, _
    
26.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
    
27.                      TextToDisplay:=.Cells(lTargetRow, "a").Text
    
28. 
    
29.     End With
    
30. End Sub

½Æ»s¥N½X

¦^´_ 2# luhpro

starry1314

¦^´_ 4# luhpro

³o¤@¬q,³Â·Ð¬Ý¬ÝÅo~
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ

¤U¸ü (17.77 KB)

2015-6-5 23:46

starry1314

¦^´_ 6# luhpro


    ³oÃä¯uªº¬Ý¤£À´...¦]¬°­ì¥»µ{¦¡¬O¥¿±`¹B§@ªº
¥u¬O«ö¶s¥²¶·©ñ¦b­n½Æ»sªº¸ê®Æ ¦P¤@¦æ ¤~¦³¿ìªk½Æ»s,
¦ý²{¦b¬O¦b¥t¥~¤@­Ó­¶­±°µ«ö¶s©I¥s¦¹¥¨¶°¦ý´N¨S¿ìªk°õ¦æ¤F.¦³¥ýÅý¥¨¶°1¥h¥ýÂI­n½Æ»s¸ê®Æªº¨º¤@¦æ ¦A©I¥s¦¹¦Û°Ê½Æ»s¸ê®Æªº¥¨¶° ¦ýÁÙ¬OµLªk§¹¦¨

starry1314

¦^´_ 8# luhpro
¥Ø«e§ï¦Ü¥H¤U¼Ò¦¡
¦ý¦b        wsTarget.Cells(lSourceRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W ·|¥X¿ù §ä¤£¥X¸Ó«ç»ò­×§ï

1. Sub ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z_¦Û°Ê§PÂ_()
   
2. '
   
3. ' ¶K¤W¸ê®Æ¦Ü_«ÈªAºÞ²z ¥¨¶°
   
4.     Dim lSourceRow As Long, lTargetRow As Long
   
5.     Dim wsTarget As Worksheet
   
6.     Dim sPath$
   
7. 
   
8.     sPath = ThisWorkbook.Path
   
9.     ChDrive sPath
   
10.     ChDir sPath
    
11.     With ActiveSheet
    
12.      lSourceRow = Selection(1).Row + 2 '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
    
13.      Windows("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Activate
    
14.      Sheets("¤@¤ë").Select
    
15.      endRow = ActiveSheet.UsedRange.Cells(Rows.Count, "B").End(xlUp).Row + 1
    
16.         Application.ScreenUpdating = False
    
17.         .Range(.Cells(endRow, "A"), .Cells(endRow, "AF")).Copy '½Æ»sAÄæ¨ìPÄ檺¸ê®Æ
    
18.         wsTarget.Cells(lSourceRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W
    
19.        wsTarget.Paste Link:=True '¶K¤W³sµ²
    
20.         Application.ScreenUpdating = True '¶K¤W³sµ²
    
21.     End With
    
22.    
    
23.     With wsTarget
    
24.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
    
25.                         Address:=ThisWorkbook.FullName, _
    
26.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
    
27.                      TextToDisplay:=.Cells(lTargetRow, "a").Text
    
28. 
    
29.     End With
    
30. End Sub

½Æ»s¥N½X

starry1314

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

starry1314

¦^´_ 8# luhpro


    ¦^´_ 8# luhpro

½Ð°ÝÃö©ó

1.          'lSourceRow = Selection(1).Row   '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
   
2.          lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row

½Æ»s¥N½X

³o¬O¥Î«ö¶s°µ,¨º¦pªG¬O¨Ï¥Î¹Ï®×©O?
µLªk¨ú±o.ButtonsÄÝ©Ê

starry1314

¦^´_ 13# luhpro


    ÁÂÁ«ü¾É~§Ú¦A¬ã¨s¤@¤U,

starry1314

¦^´_ 13# luhpro


    ¥t¥~,³o¤@¦æÀ³¸Ó¬O¤£¹ïªº°Ú:
Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets(.cells("¤@¤ë")
Cells() ªº¬A©·¤¤¶¡¥u¯à¬O ¦C¸¹,¦æ¸¹ ¦Ó¤£¯à¬O¦r¦ê,
¥B§A¸Ó¦æªº¬A¸¹¤]¨S¦³¦¨¹ï.

·|¤£·|¬O ¦]«e­±¬O¦³¥Î¤é´Á§PÂ_­n¨Ï¥Î­þ­Ó¤ë¥÷sheets ©Ò¤wcells¤~¥i¥Î

1. Function GetMonthStr(inDate As Date) As String
   
2.     Select Case Month(inDate)
   
3.         Case 1
   
4.             GetMonthStr = "¤@¤ë"
   
5.         Case 2
   
6.             GetMonthStr = "¤G¤ë"
   
7.         Case 3
   
8.             GetMonthStr = "¤T¤ë"
   
9.         Case 4
   
10.             GetMonthStr = "¥|¤ë"
    
11.         Case 5
    
12.             GetMonthStr = "¤­¤ë"
    
13.         Case 6
    
14.             GetMonthStr = "¤»¤ë"
    
15.         Case 7
    
16.             GetMonthStr = "¤C¤ë"
    
17.         Case 8
    
18.             GetMonthStr = "¤K¤ë"
    
19.         Case 9
    
20.             GetMonthStr = "¤E¤ë"
    
21.         Case 10
    
22.             GetMonthStr = "¤Q¤ë"
    
23.         Case 11
    
24.             GetMonthStr = "¤Q¤@¤ë"
    
25.         Case 12
    
26.             GetMonthStr = "¤Q¤G¤ë"
    
27.     End Select
    
28. End Function

½Æ»s¥N½X

starry1314

¦^´_ 16# luhpro


    ³o´N¤£¤F¸Ñ¤F...¦]§Ú·íªì¶Kªº¨º¬q¬O¥i¥¿±`¹B§@~
«á¨Ó±Nªí®æ²Î¤@¦b¤@­Ó,´N¨S¦³¨Ï¥Î³o¬q«ü¥O¤F ,
§ï¨Ï¥Î¹³§AÁ¿ªº
­Y­n¤Þ¥Î§A 15# ©Ò­zªº Function,
¨º»ò¸Ó¦æ¤j¬ùÀ³¸Óªø¦¨©³¤U³o¼Ë :
Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets(GetMonthStr(inDate))
¨Ï¥Î¬°
Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets("«È¤á©ú²Ó")
¥t·Q½Ð°ÝinDate¬O?