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

[µo°Ý] ·í¬Y­ÓÀx¦s®æ¼Æ­È>50,«h¥ß§Y°O¿ý«ü©wÄæ¦ìªº­È(¨DVBA)

[µo°Ý] ·í¬Y­ÓÀx¦s®æ¼Æ­È>50,«h¥ß§Y°O¿ý«ü©wÄæ¦ìªº­È(¨DVBA)

­º¥ý·PÁÂ¥»°Q½×°Ï ²³ª©¥D¤Îºô¤Í­Ì
¦³§A­ÌªºÀ°§U Åý¤p§Ì ¾Ç²ß¨ì§ó¦hª¾ÃÑ
ÁÂÁ§A­Ì


¤p§Ì¦³¨Æ ·Q½Ð°Ý,½Ð¸s¤Wªº°ª¤â À°¦£
¦b¦¹¥ý·PÁ¤j®a À°¦£  ÁÂÁÂ
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sheet2 ªºC13 ¬O¤@­Ó¨C¬í³£·|Åܰʪº¼Æ

·íC13>50 ®É
VBA ·|¥ß§Y¦Û°Ê°O¿ý A17:D17 ³o¥|Ä檺¸ê®Æ(ABCDªº¸ê®Æ ¤]¬OÅܰʪº­È)
¨ìsheet3
¨Ã¥B±qsheet3ªº A2¶}©l°O¿ý
¨Ì§Ç©¹¤U¬ö¿ý





¤p§ÌªºÀÉ®×
Book2.rar (7.71 KB)
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

¸Õ¸Õ¬Ý!
¤U¦CVBA©ñ¨ìSheet1("Sheet2")ªºvba¤¤,
¤£­n©ñModule1¤¤
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim Rng As Range, LastR As Integer, sh3 As Object
  3.     Set sh3 = Sheets("Sheet3")
  4.     Set Rng = [C13]       '³]©w [C13] ¬° Worksheet_ChangeIJ°Ê½d³ò
  5.     LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
  6.     If Not Intersect(Target, Rng) Is Nothing And Rng.Value > 50 Then
  7.         [A17].Resize(1, 4).Select
  8.         [A17].Resize(1, 4).Copy sh3.Cells(LastR, 1)
  9.     End If
  10. End Sub
½Æ»s¥N½X

TOP

¸Õ¸Õ¬Ý!
¤U¦CVBA©ñ¨ìSheet1("Sheet2")ªºvba¤¤,
¤£­n©ñModule1¤¤
yen956 µoªí©ó 2017-2-18 12:33


·PÁ¤j¤j
¥Ø«ecopy¹L¨Óªº¬O¤½¦¡
¦Ó¤£¬O­È

¥i¥Hcopy­È¹L¨Ó¶Ü

·PÁ¦A·PÁÂ
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

Private Sub Worksheet_Change(ByVal Target As Range)
    '°²©w "C13" ªº¤½¦¡¬° =[A1]+[B1]+[E1]
    '«h Change ªº Target ¬° [A1] or [B1] or [E1]
    Dim Rng As Range, LastR As Integer, sh3 As Object
    Set sh3 = Sheets("Sheet3")
    Set Rng = Union([A1:B1], [E1])      '³]©w Worksheet_ChangeIJ°Ê½d³ò(»P¤½¦¡¦³ÃöªºRange­n¥þ³¡©ñ¶i¥h)
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o "Sheet3" ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If Not Intersect(Target, Rng) Is Nothing Then
        If [C13] > 50 Then
            [A17].Resize(1, 4).Select
            [A17].Resize(1, 4).Copy sh3.Cells(LastR, 1)
        End If
    End If
End Sub

TOP

¸Õ¸Õ¬Ý!
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, LastR As Integer, sh3 As Object
    Set sh3 = Sheets("Sheet3")
    Set Rng = [C13]       '³]©w [C13] ¬° Worksheet_ChangeIJ°Ê½d³ò
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If Not Intersect(Target, Rng) Is Nothing And Rng.Value > 50 Then
        [A17].Resize(1, 4).Select
        [A17].Resize(1, 4).Copy sh3.Cells(LastR, 1)
    End If
End Sub
yen956 µoªí©ó 2017-2-18 12:33

~~~~~~~~~~~~~~~~~~~~~~~
·PÁ  yen956 ¤j¤jªº¼ö±¡¦^ÂÐ

§Ú¬O·Q­n ±NA17:19 ½Æ»s¨ìSHEET3

¦]¬°§Ú°õ¦æ¤j¤jVBA «á
¥L·|±NA17:19  ¥Î¤½¦¡ªº¤è¦¡ COPY ¨ì SHEET3 ¥h

¥i¥H±NCOPY §e²{¥X §Ú­nªº¤è¦¡¶Ü??

¦A¦¸·PÁ yen956 ¤j¤j¼ö±¡ªºÀ°¦£
ÁÂÁ§A






¤p§Ì ±N§Úªº Àɮתþ¤W ½Ð¤j¤j ¦bÀ°§Ú¬Ý¬Ý
Book2----.rar (8.07 KB)
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

¦^´_ 5# peter95
¸Õ¸Õ¬Ý!
±N
     [A17].Resize(1, 4).Copy sh3.Cells(LastR, 1)
§ï¦¨      
     [A17].Resize(1, 4).Copy
        sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

©Î
±N¾ã­ÓWorksheet_Change()§R°£
§ï¦¨
Private Sub Worksheet_Calculate()
    Dim Rng As Range, LastR As Integer, sh3 As Object
    Set sh3 = Sheets("Sheet3")
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o "Sheet3" ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If [C13] > 50 Then
        [A17].Resize(1, 4).Copy
        sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
End Sub
¸Õ¸Õ¬Ý!

TOP

¥»©«³Ì«á¥Ñ peter95 ©ó 2017-2-21 17:47 ½s¿è

¦^´_ 6# yen956

¦A¦¸ÁÂÁ yen956¤j¤j

¥Ø«e´ú¸Õ¤w¸g¥i¥H±N ¸ê®Æ¬ö¿ý¤U¨Ó
½Ð°Ý¤j¤j
­Y¤@¼Ë¬O¥HC13>50 ¬°¨Ò
·íC13>50 ®É ¤@¼Ë±N  A17:D17 ªº¸ê®Æ
¥i§_¥Î IJµo¥\¯à µoMAIL©Î 66.JPG µ¹§Ú©O??

«D±`·PÁ¤j¤jªºÀ°¦£
ÁÂÁÂ
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

¦^´_  peter95
Private Sub Worksheet_Calculate()
    Dim Rng As Range, LastR As Integer, sh3 As Object
    Set sh3 = Sheets("Sheet3")
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o "Sheet3" ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If [C13] > 50 Then
        [A17].Resize(1, 4).Copy
        sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
End Sub
yen956 µoªí©ó 2017-2-20 18:25


¥i¥H±N¤W¦CVBA ©µ«á ¤G¤ÀÄÁ°õ¦æ¶Ü???
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

¥»©«³Ì«á¥Ñ yen956 ©ó 2017-2-22 20:08 ½s¿è

©êºp, E-mail §Ú¤£·|, ¥i¥tµo¤å½Ð±Ð¨ä¥L¤j¤j,
¨C2¤ÀÄÁ«h¥i­É¥Î Hsiehª©¤jªº onTime, ¦p¤U:

Worksheet_Calculate §R°£, §ï¥Î Hsiehª©¤jªº onTime
½Ð©ñ¦b Module
http://forum.twbts.com/thread-19283-1-2.html
'±q¦­¤W8ÂI¨ì¤U¤È5ÂI¨C2¤ÀÄÁ°õ¦æ "Copy_test" 1¦¸
Sub OnTime_test()
    Dim t
    For t = TimeValue("08:00:00") To TimeValue("17:00:00") Step TimeValue("00:02:00")
       Application.OnTime t, "Copy_test"
    Next
End Sub

Sub Copy_TEST()
    Dim LastR As Integer, sh2 As Object, sh3 As Object
    Set sh2 = Sheets("Sheet2")
    Set sh3 = Sheets("Sheet3")
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o "Sheet3" ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If sh2.[C13] > 50 Then
        sh2.[A17].Resize(1, 4).Copy
        sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
    End If
End Sub

TOP

¥»©«³Ì«á¥Ñ peter95 ©ó 2017-2-22 20:19 ½s¿è
©êºp, E-mail §Ú¤£·|, ¥i¥tµo¤å½Ð±Ð¨ä¥L¤j¤j,
¨C2¤ÀÄÁ«h¥i­É¥Î Hsiehª©¤jªº onTime, ¦p¤U:

Worksheet_C ...
yen956 µoªí©ó 2017-2-22 20:06


·PÁÂyen956¤j¤j

§Úªº·N«ä¬O ·í§Ú¶}±Ò§ÚªºEXCELÀÉ®É
©µ«á2¤ÀÄÁ ¤~¥h°õ¦æ §A¤U¦CªºVBA
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Worksheet_Calculate()
    Dim Rng As Range, LastR As Integer, sh3 As Object
    Set sh3 = Sheets("Sheet3")
    LastR = sh3.[A65536].End(xlUp).Row + 1       '¨ú±o "Sheet3" ÄæA³Ì¤U­±«DªÅ¥Õ®æªº¤U¤@®æ ªº¦C¸¹
    If [C13] > 50 Then
        [A17].Resize(1, 4).Copy
        sh3.Cells(LastR, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
¦Ó¤£¬O¨C2¤ÀÄÁ¬ö¿ý¤@¦¸
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD