Hsieh

¦^´_ 1# milkpillow

1. Sub Q_Table()
   
2. Dim A As Range, C As Range, Ar()
   
3. With Sheets("B¥þ³¡¬ö¿ý")
   
4. For Each A In .Range(.[A2], .[A1048576].End(xlUp))
   
5.    Set C = Sheets("A¦¬¶°").Columns("C").Find(A, lookat:=xlWhole)
   
6.      If Not C Is Nothing Then
   
7.        ReDim Preserve Ar(s)
   
8.        Ar(s) = Array(C.Offset(, -2).Value, C.Offset(, -1).Value, A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
   
9.        s = s + 1
   
10.    End If
    
11. Next
    
12. End With
    
13. Sheets("C¿é¥X").[A2:E1048576].Clear
    
14. If s > 0 Then Sheets("C¿é¥X").[A2].Resize(s, 5) = Application.Transpose(Application.Transpose(Ar))
    
15. Sheets("C¿é¥X").Select
    
16. End Sub

½Æ»s¥N½X

pro.rar (19.82 KB)

¤U¸ü¦¸¼Æ: 40

2010-5-29 09:01

Hsieh

¦^´_ 5# milkpillow


    ³o¼Ë2­ÓªíªºÃöÁp©Ê¤£¨¬
¨Ã¤£ª¾¹D¨Cµ§½T©wªº¤ñ¹ï¹ï¶H
½Ð»¡©ú2ªí¸ê®Æªº¤ñ¹ï³W«h
­«·s«ä¦ÒÅÞ¿è

Hsieh

¦^´_ 7# milkpillow


    A¦¬¶°ªº«~¦W¸òB¥þ³¡¸ê®ÆªºOS_NAME¦³¬Æ»òÃö³s¹ïÀ³¯Á¤Þ?
©Î¬O½T©w¼Æ¶q·|¬Û¦P?

Hsieh

¦^´_ 9# milkpillow

¸Õ¸Õ¬Ý¬O¤£¬O³o¼Ëªº·N«ä

1. Sub matchdata()
   
2. Dim Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheet2
   
5.   For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
6.      If d.exists(A.Value) = False Then
   
7.         d(A.Value) = Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
   
8.         Else
   
9.         d(A.Value) = d(A.Value) & ";" & Join(Array(A, A.Offset(, 1), A.Offset(, 2), A.Offset(, 3)), ",")
   
10.      End If
    
11.     Next
    
12. End With
    
13. With Sheet1
    
14.    For Each A In .Range(.[C2], .[C65536].End(xlUp))
    
15.       If d.exists(A.Value) = True Then
    
16.          Ar = Split(d(A.Value), ";")
    
17.          For i = 0 To UBound(Ar)
    
18.          ReDim Preserve Ay(s)
    
19.          Ay(s) = Split(A.Offset(, -2) & "," & A.Offset(, -1) & "," & Ar(i), ",")
    
20.          s = s + 1
    
21.          Next
    
22.          Else
    
23.          If mystr = "" Then mystr = A Else mystr = mystr & "," & A
    
24.         End If
    
25.     Next
    
26. End With
    
27. With Sheet3
    
28. .[A2:F65536] = ""
    
29. .[A2].Resize(s, 6) = Application.Transpose(Application.Transpose(Ay))
    
30. MsgBox mystr & "¨S§ä¨ì"
    
31. End With
    
32. End Sub

½Æ»s¥N½X

Hsieh

®Ä¯à¦p¦ó´N¬Ý§A°O¾ÐÅé°÷¤£°÷
¦pªGÅܼƳ£§¹¦¨«Å§i´N·|¦n¤@ÂI