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

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

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

¥»©«³Ì«á¥Ñ starry1314 ©ó 2015-6-3 15:49 ½s¿è

¦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.     End With
  24. End Sub
½Æ»s¥N½X

¦p¦ó¥[¤J¥H¤U«ü¥O©O? ¦]§Ú¥[¶iDim wsTarget As Worksheet
©³¤U ¦n¹³·|³y¦¨«ö¶s¦æ¤£¹ï ©Ò¥H¨S¿ìªk§PÂ_~
©Î ...
starry1314 µoªí©ó 2015-6-3 15:47
  1. Dim wsTarget As Worksheet
  2. '===== ¥[©³¤U³o¨Ç«ü¥O=====
  3. Dim sPath$

  4. sPath = ThisWorkbook.Path
  5. ChDrive sPath
  6. ChDir sPath
  7. '===== ¥[¤W­±³o¨Ç«ü¥O=====
  8.     With ActiveSheet
½Æ»s¥N½X

TOP

¤w¥[¤J ¦ý·|¸õ¥X °õ¦æµ{»Ý©Î©I¥s¿ù»~
  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. sPath = ThisWorkbook.Path
  8. ChDrive sPath
  9. ChDir sPath
  10.     With ActiveSheet
  11.         lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '³QÂIÀ»ªº¸Ó«ö¶s¦æ¼Æ
  12.         If .Cells(lSourceRow, "C").Text = vbNullString Then MsgBox "¤é´ÁÄæµL¸ê®Æ¡AµLªk§PÂ_¶K¤W¤ë¥÷": Exit Sub
  13.         Set wsTarget = Workbooks("«È¤á©ú²Ó-«ÈªA±M¥Î.xlsm").Sheets(GetMonthStr(.Cells(lSourceRow, "C"))) '¤é´Á§PÂ_­n¶K¤Wªº¤u§@ªí
  14.         lTargetRow = wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1  '­n¶K¤Wªº¦ì¸m
  15.         Application.ScreenUpdating = False
  16.         .Range(.Cells(lSourceRow, "A"), .Cells(lSourceRow, "AF")).Copy '½Æ»sAÄæ¨ìPÄ檺¸ê®Æ
  17.         wsTarget.Cells(lTargetRow, "B").PasteSpecial Paste:=xlPasteValues '¦bBÄæ¶}©l¶K¤W
  18.        wsTarget.Paste Link:=True '¶K¤W³sµ²
  19.         Application.ScreenUpdating = True '¶K¤W³sµ²
  20.     End With
  21.    
  22.     With wsTarget
  23.         .Hyperlinks.Add Anchor:=.Cells(lTargetRow, "A"), _
  24.                         Address:=ThisWorkbook.FullName, _
  25.                         SubAddress:=ThisWorkbook.ActiveSheet.Name & "!" & Rows(lSourceRow).Address, _
  26.                      TextToDisplay:=.Cells(lTargetRow, "a").Text

  27.     End With
  28. End Sub
½Æ»s¥N½X
¦^´_ 2# luhpro

TOP

¤w¥[¤J ¦ý·|¸õ¥X °õ¦æµ{»Ý©Î©I¥s¿ù»~
¦^´_  luhpro
starry1314 µoªí©ó 2015-6-4 15:47

§Ú´£¨Ñªº«ü¥O­Yµo¥Í¿ù»~,
­ì¦]¤j³¡¤ÀÀ³¸Ó³£¬O "§ä¤£¨ì¸ô®|" ¤~¹ï.

§Aªºµ{¦¡¥E¬Ý¤§¤U¬Ý¤£¥X¨Ó¿ù»~¦b­þ¸Ì,
§A¸Õ¸Õ«ö¤U "°»¿ù" «ö¶s,
¬Ý¬Ý¬O­þ¤@¦æµo¥Í¦¹¿ù»~.

TOP

¦^´_ 4# luhpro

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

TOP

¦^´_  luhpro

³o¤@¬q,³Â·Ð¬Ý¬ÝÅo~
lSourceRow = .Buttons(Application.Caller).TopLeftCell.Row   '³Q ...
starry1314 µoªí©ó 2015-6-5 23:48

«ü¥O¹ï¶H»P©I¥s¤è¦¡³£¤£¥¿½T³á :
Caller ÄÝ©Ê
¶Ç¦^Ãö©ó©I¥s Visual Basic ªº¸ê°T (¸Ô²Ó¤º®e½Ð°Ñ¾\ [³Æµù] ³¡¥÷)¡C

expression.Caller(Index)
expression    ¥²¿ï¡C¦¹¹Bºâ¦¡·|¶Ç¦^ Application ª«¥ó¡C

Index    ¿ï¾Ü©Êªº Variant¡C°}¦Cªº¯Á¤Þ¡C¶È·í¥»ÄݩʶǦ^°}¦C®É¦¹¤Þ¼Æ¤~¦³¥Î (¸Ô²Ó¤º®e½Ð°Ñ¾\ [³Æµù] ³¡¥÷)¡C

³Æµù
¥»ÄݩʱN¶Ç¦^Ãö©ó©I¥s Visual Basic ªº¸ê°T¡A¦p¤Uªí©Ò¥Ü¡C

©I¥sªÌ                                                                                                                 ¶Ç¦^­È
¦b³æ¤@Àx¦s®æ¤¤¿é¤Jªº¦Û­q¨ç¼Æ                                                                     ¥Nªí¸ÓÀx¦s®æªº Range ª«¥ó
¦bÀx¦s®æ½d³ò¤¤§@¬°°}¦C¤½¦¡¤@³¡¥÷ªº¦Û­q¨ç¼Æ                                         ¥Nªí¸ÓÀx¦s®æ½d³òªº Range ª«¥ó
Auto_Open¡BAuto_Close¡BAuto_Activate ©Î Auto_Deactivate ¥¨¶°  ¥H¤å¦r¼Ò¦¡¶Ç¦^ªº¤å¥ó¦WºÙ
¥ÑOnDoubleClick ©Î OnEntry ÄÝ©Ê©Ò³]©wªº¥¨¶°                                      ¸Ó¥¨¶°©Ò®M¥Îªº¹Ïªíª«¥ó¿ëÃѲŸ¹©ÎÀx¦s®æ°Ñ·Ó (­Y¾A¥Î) ªº¦WºÙ
[¤u¨ã] ¥\¯àªí¤¤ªº [¥¨¶°] ¹ï¸Ü¤è¶ô¡A©Î¤W­z¤§¥~ªº¨ä¥L©I¥sªÌ                #REF! ¿ù»~­È

TOP

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

TOP

¥»©«³Ì«á¥Ñ luhpro ©ó 2015-6-6 00:36 ½s¿è
¦^´_  luhpro
    ³oÃä¯uªº¬Ý¤£À´...¦]¬°­ì¥»µ{¦¡¬O¥¿±`¹B§@ªº
¥u¬O«ö¶s¥²¶·©ñ¦b­n½Æ»sªº¸ê®Æ ¦P¤@¦æ ...
starry1314 µoªí©ó 2015-6-6 00:27

§A¤£¥Î³o¼Ë³]­p°Ú.

¦pªG­n°Ï¤Àªº¬O«ö¶s:
¥u­n³]©w¤@­Ó¥þ°ìÅܼÆ,
±µµÛ¦b¨C¤@­Ó«ö¶sªº Click ³B²zµ{§Ç°Ï¶ô¤º¦U§O³]©w¦¹ÅܼƤ£¦Pªº­È,
´N¥i¥H°Ï¤À¤F.

¦pªG­n°Ï¤Àªº¬O³Q¿ï¨úªºÀx¦s®æ:
Selection(1).Address ¥i¨ú±o $A$2 §Î¦¡ªºÀx¦s®æ¦ì§}
Selection(1).Row ¨ú±o¨ä¦C¸¹
Selection(1).Column ¨ú±o¨äÄ渹
¥Î (1) ¬O¥u¨ú¥ª¤W¨¤¨º¤@­ÓÀx¦s®æ,
Á׶}¦h¿ï®ÉÀx¦s®æ¥Ø¼Ð¤Ó¦hªº±¡§Î.

TOP

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

  27.     End With
  28. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ 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

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD