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

[µo°Ý] ¸ê®ÆÂಾ

[µo°Ý] ¸ê®ÆÂಾ

¥»©«³Ì«á¥Ñ ounmaxz ©ó 2010-6-10 16:14 ½s¿è

½Ð¦U¦ì¤j¤jÀ°¦£¤@¤U±N¥[¯Z²Î­pªí¤ºªº¸ê®Æ
¸g¿é¤J¤é´Á«á±N¸ê®ÆÂಾ¨ì¥[¯Z²Î­pªí¤º
¦³¶ñ¤J¥[¯Z®É¶¡¤Î¥[¯Z¨Æ¥Ñ¤~²¾Âà
·Ð½Ð¦U¦ì¤j¤jÀ°¦£   ¥[¯Z.rar (13.53 KB)

Sub nn()
Dim Rng As Range, A As Range, Cell As Range
With Sheet2
Set Rng = .Range(.[N5], .[N7].End(xlUp)) '³]¸m¤ñ¹ïªº¼Ð·Ç°Ï°ì
End With
With Sheet1
For Each A In .Range(.[A1], .[A65536].End(xlUp)) '¦bsheet1ªºdÄæ¸ê®Æ´`Àô
    If Not Rng.Find(A, lookat:=xlWhole) Is Nothing Then '¦pªG¼Ð·Ç°Ï§ä¨ìdÄ檺­È
       If Cell Is Nothing Then Set Cell = A Else Set Cell = Union(Cell, A) '¦pªGÅܼÆCell¬O¤£¬Oª«¥ó´N±NdÄæ³]µ¹Cell§_«hCell´N·|±N­ì¨Ó½d³ò¼W¥[¤@Àx¦s®æA
    End If
Next
End With
Sheet3.Cells = "" '²MªÅSheet3¤º®e
Cell.EntireRow.Copy Sheet3.[A2] '§âSheet1²Å¦Xªº¦C½Æ»s¨ìSheet3ªºA1
   
End Sub
¥H¤Wµ{¦¡½X¬O¤p§Ì±q½׾½¥X¨Ó¶i¦æ¤p­×§ï«áªº
¤p§Ì§Æ±æ§ï´X­Ó¤p¦a¤è¦ý¬OµL©`¹ïVBA¤£¼ô±x
µL±q­×§ï·Ð½Ð¤j¤j¨ó§U¤@¤U
¤W­±ªº²Ä¤@¶µ¿z¿ï±ø¥ó¬O¤é´Á
¦ý¬O¤p§ÌÁٻݭn¦³NÄ榳¥[¯Zªº¤~¿z¿ï¥X¨Ó
²Ä¤G¬O¦¹µ{¦¡½X·|±N®æ¬O¤Î¤½¦¡±a¹L¨Ó¤p§Ì§Æ±æ¥u±a­È´N¦n
Sheet3.Cells = "" '²MªÅSheet3¤º®e¬O§_¯à§ï¦¨¥u²MªÅ¾A·í°Ï°ì
¥[¯Z¥Ó½Ðªí¤º[A5¡AH20]
·Ð½Ð¦U¦ì¤j¤jÀ°À°¦£
¥[¯Z.rar (39.62 KB)

TOP

¦^´_ 2# ounmaxz


    ¬Ý¤£¥X³æ¦ì¦p¦ó¹ïÀ³¥ý¥H"³æ¦ì"¥Nªí
  1. Sub nn()
  2. Dim Rng As Range, A As Range, Ar(), Ay()
  3. With Sheet2
  4. Set Rng = .Range(.[N5], .[N7].End(xlUp)) '³]¸m¤ñ¹ïªº¼Ð·Ç°Ï°ì
  5. With Sheet1
  6. ReDim Preserve Ay(0)
  7. Ay(0) = .[A1].Resize(, 14).Value
  8. For Each A In .Range(.[A1], .[A65536].End(xlUp)) '¦bsheet1ªºdÄæ¸ê®Æ´`Àô
  9.     If Not Rng.Find(A, lookat:=xlWhole) Is Nothing And A.Offset(, 13) = "¥[¯Z" Then '¦pªG¼Ð·Ç°Ï§ä¨ìdÄ檺­È
  10.        ReDim Preserve Ar(s)
  11.        ReDim Preserve Ay(s + 1)
  12.        Ar(s) = Array("³æ¦ì", A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
  13.        Ay(s + 1) = A.Resize(, 14).Value
  14.        s = s + 1
  15.     End If
  16. Next
  17. End With
  18. .[A5:I20] = ""
  19. Sheet3.Cells = "" '²MªÅSheet3¤º®e
  20. If s > 0 Then .[A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar)): _
  21. Sheet3.[A1].Resize(s + 1, 14) = Application.Transpose(Application.Transpose(Ay)) '§âSheet1²Å¦Xªº¦C½Æ»s¨ìSheet3ªºA1
  22. End With
  23. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 3# Hsieh


   ·PÁÂHsieh¤j¤jªºÀ°¦£¦³¨â­Ó°ÝÃD­n¦b³Â·Ð¤j¤jÀ°¦£
1.Ar(s) = Array("³æ¦ì", A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
       Ay(s + 1) = A.Resize(, 14).Value
       s = s + 1
¬õ¦âªº³¡¤À¯à¤£¯à§ï¦¨¥Ñªþ¥óSheet2¤ºªº­È¨Ó¨ú¥N
²Ä2ªº³¡¤À¦bªþ¥óSHEET1¸Ì¦³»¡©ú¤ñ¸û²M·¡

¦A¦¸³Â·Ð¤j¤j
¥[¯Z.rar (42.55 KB)

TOP

¦^´_ 4# ounmaxz
  1. Sub nn()
  2. Dim Rng As Range, A As Range, Ar(), Ay()
  3. With Sheet2
  4. Ut = .[P5].Value
  5. Set Rng = .Range(.[N5], .[N65536].End(xlUp)) '³]¸m¤ñ¹ïªº¼Ð·Ç°Ï°ì
  6. With Sheet1
  7. ReDim Preserve Ay(0)
  8. Ay(0) = .[A1].Resize(, 14).Value
  9. For Each A In .Range(.[A1], .[A65536].End(xlUp)) '¦bsheet1ªºdÄæ¸ê®Æ´`Àô
  10.     If Not Rng.Find(A, lookat:=xlWhole) Is Nothing And A.Offset(, 13) = "¥[¯Z" Then '¦pªG¼Ð·Ç°Ï§ä¨ìdÄ檺­È
  11.        ReDim Preserve Ar(s)
  12.        ReDim Preserve Ay(s + 1)
  13.        Ar(s) = Array(Ut, A.Value, A.Offset(, 1).Value, "", A.Offset(, 2).Value, Format(A.Offset(, 3).Value, "hh:mm"), Format(A.Offset(, 4).Value, "hh:mm"), A.Offset(, 5).Value)
  14.        Ay(s + 1) = A.Resize(, 14).Value
  15.        s = s + 1
  16.     End If
  17. Next
  18. End With
  19. .[A5:I20] = ""
  20. Sheet3.Cells = "" '²MªÅSheet3¤º®e
  21. If s > 0 Then .[A5].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar)): _
  22. Sheet3.[A1].Resize(s + 1, 14) = Application.Transpose(Application.Transpose(Ay)) '§âSheet1²Å¦Xªº¦C½Æ»s¨ìSheet3ªºA1
  23. End With
  24. End Sub

  25. Sub yy() '¶ñº¡¤é´Á
  26. y = InputBox("¿é¤J¦è¤¸¦~«×", , 2010)
  27. With Sheet1
  28. Ar = .[B2:C17].Value
  29. r = 2
  30. For i = DateValue(y & "/1/1") To DateValue(y & "/12/31")
  31.   .Cells(r, 1).Resize(16, 1) = i
  32.   .Cells(r, 2).Resize(16, 2) = Ar
  33.   r = r + 16
  34. Next
  35. End With
  36. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

·PÁÂHsieh ªº¼ö±¡À°§UÅý¤p§Ì¨ü¯q¨}¦h

TOP

        ÀR«ä¦Û¦b : ·R¤£¬O­n¨D¹ï¤è¡A¦Ó¬O­n¥Ñ¦Û¨­ªº¥I¥X¡C
ªð¦^¦Cªí ¤W¤@¥DÃD