­ã´£³¡ªL

2007¶]¡A³t«×¶W¯ÅºC¡A°_½X­n20-30¤ÀÄÁ¡H¡@

¤£¨ì¢³¢¯¢¯µ§¡AÀ³¤£­P¦p¦¹¤[¡I¡I¡I
°£«D¹ê»ÚÀɮפ¤ÁÙ¦³¨ä¥¦¤u§@ªí¡A¥B±a¦³¤j¶q¤½¦¡¡A³y¦¨¨C¶K¤@¦¸¸ê®Æ¡A§Y¦Û°Ê­«ºâ¤@¦¸¡I

¨Ï¥ÎUNION¶°¦¨¤§«á¦A¶K¸ê®Æ¡A·|§Ö«Ü¦h¡A¦ý©Ò¤W¶ÇªºÀɮפ¤¡A¤u§@ªí¢°ªº¢ÏÄæ¥N¸¹¦³«Ü¦h­«ÂСAµLªk¨Ï¥Î¦¹ªk¡I¡I

¥ý¸Õ¸Õ¥H¤U­×§ï½X¡]¥u­×§ï¢ÑÄæMATCH¤½¦¡¡^¡A¦bXP+2000¤¤¬ù¤@¤ÀÄÁ¥i¦¨¡]¢²¢·¢µ¦C¡^¡G
Sub Macro1()
Dim G&, TM, i&
TM = Time
Sheets("¤u§@ªí1").Select
x1 = Application.WorksheetFunction.CountA(Range("A:A"))
Range("D2:U" & x1).Clear
With Range("C2:C" & x1)
¡@¡@¡@.Formula = "=MATCH(A2,­º­¶!$A$1:$A$3000,)"
¡@¡@¡@.Value = .Value
End With
Application.ScreenUpdating = False
For i = 2 To x1
¡@¡@¡@G = Cells(i, "C")
¡@¡@¡@Sheets("­º­¶").Range("F" & G & ":" & "P" & G).Copy Sheets("¤u§@ªí1").Range("D" & i)   'D-N
¡@¡@¡@Sheets("°ò¥»­±").Range("G" & G & ":" & "I" & G).Copy Sheets("¤u§@ªí1").Range("O" & i) 'O-Q
¡@¡@¡@Sheets("°ò¥»­±").Range("D" & G & ":" & "E" & G).Copy Sheets("¤u§@ªí1").Range("R" & i)  'R-S
¡@¡@¡@Sheets("°ò¥»­±").Range("E" & G).Copy Sheets("¤u§@ªí1").Range("T" & i)
¡@¡@¡@Sheets("°ò¥»­±").Range("F" & G).Copy Sheets("¤u§@ªí1").Range("U" & i)
Next
MsgBox "§¹¦¨®É¶¡" & Format(Time - TM, "hh:mm:ss")
End Sub

­ã´£³¡ªL

±N¢ÏÄæ­«ÂÐ¥N¸¹¥ý§R°£¡A¦A¸Õ¸Õ¡G¡]ª`·N¡G©Ò¦³ªí®æªº¥N¸¹¥²¶·¥ý±Æ§Ç¡^¡@
Sub Macro2()
Dim G&, TM, i&, xU(1 To 5) As Range, xR As Range, x1&
TM = Time
Sheets("¤u§@ªí1").Select
x1 = Application.WorksheetFunction.CountA(Range("A:A"))
Range("D2:U" & x1).Clear
¡@
With Range("C2:C" & x1)
¡@¡@¡@.Formula = "=MATCH(A2,­º­¶!$A$1:$A$3000,)"
¡@¡@¡@.Value = .Value
End With
¡@
Application.ScreenUpdating = False
For i = 2 To x1
¡@¡@G = Cells(i, "C")
¡@¡@Set xR = Sheets("­º­¶").Range("F" & G & ":" & "P" & G)
¡@¡@If i = 2 Then Set xU(1) = xR Else Set xU(1) = Union(xU(1), xR)
¡@
¡@¡@Set xR = Sheets("°ò¥»­±").Range("G" & G & ":" & "I" & G)
¡@¡@If i = 2 Then Set xU(2) = xR Else Set xU(2) = Union(xU(2), xR)
¡@¡@   
¡@¡@Set xR = Sheets("°ò¥»­±").Range("D" & G & ":" & "E" & G)
¡@¡@If i = 2 Then Set xU(3) = xR Else Set xU(3) = Union(xU(3), xR)
    ¡@
¡@¡@Set xR = Sheets("°ò¥»­±").Range("E" & G)
¡@¡@If i = 2 Then Set xU(4) = xR Else Set xU(4) = Union(xU(4), xR)
    ¡@
¡@¡@Set xR = Sheets("°ò¥»­±").Range("F" & G)
¡@¡@If i = 2 Then Set xU(5) = xR Else Set xU(5) = Union(xU(5), xR)
Next
¡@
For i = 1 To 5
¡@¡@xU(i).Copy Range(Array("D2", "O2", "R2", "T2", "U2")(i - 1))
Next i
MsgBox "§¹¦¨®É¶¡" & Format(Time - TM, "hh:mm:ss")
End Sub

­ã´£³¡ªL

¨Ï¥Î¡e°Ï¬q¡f³B²z¡A¢ÑÄæ¡e±q¤p¨ì¤j¡f¬°¤@­Ó°Ï¬q¡G
Sub °õ¦æ()
Dim G&, TM, i&, j%, R&
TM = Time
Sheets("¤u§@ªí1").Select
R = Cells(Rows.Count, 1).End(xlUp).Row
With Range("C2:C" & R): .Formula = "=MATCH(A2,­º­¶!A$1:A$3000,)": .Value = .Value: End With
Application.ScreenUpdating = False
Dim xU(1 To 4) As Range, xR(1 To 4) As Range, X&, N&
X = 1: N = 2
RE_GET:
For i = X + 1 To R
¡@¡@G = Cells(i, "C")
¡@¡@Set xR(1) = [­º­¶!F1:P1].Offset(G - 1, 0)
¡@¡@Set xR(2) = [°ò¥»­±!G1:I1].Offset(G - 1, 0)
¡@¡@Set xR(3) = [°ò¥»­±!D1:E1].Offset(G - 1, 0)
¡@¡@Set xR(4) = [°ò¥»­±!E1:F1].Offset(G - 1, 0)
¡@¡@For j = 1 To 4
¡@¡@¡@¡@If xU(j) Is Nothing Then Set xU(j) = xR(j) Else Set xU(j) = Union(xU(j), xR(j))
¡@¡@Next j
¡@¡@If G >= Cells(i + 1, "C") Then X = i: Exit For
Next
For j = 1 To 4
¡@¡@xU(j).Copy Range(Array("D1", "O1", "R1", "T1")(j - 1)).Cells(N, 1)
¡@¡@Set xU(j) = Nothing: Set xR(j) = Nothing
Next j
N = X + 1
If X < R Then GoTo RE_GET
MsgBox "§¹¦¨®É¶¡" & Format(Time - TM, "hh:mm:ss")
End Sub

ªþÀɤU¸ü¡G
Xl0000231.rar (231.44 KB)

¤U¸ü¦¸¼Æ: 5

2015-12-23 14:33

¡@

­ã´£³¡ªL

¦^´_ 7# spermbank


¨º©³¦â¬O¡e®æ¦¡¤Æ±ø¥ó¡f¡A²M°£§Y¥i¡A»Pµ{¦¡µLÃö¡ã¡ã
¥u¯à´£¨Ñ½Æ»s³¡¥÷¡A
©Ò´£¤W¤U¬qµ{¦¡¬O§_¦³¬Û½Ä¬ð©Î¼vÅT¡AµLªk§PÂ_¡A½Ð¦Û¦æ¥ý®M¬Ý¬Ý¡ã¡ã