¤T­Ó¤u§@ªí¦X¨Ö°ÝÃD

aok669

¦U¦ì«e½ú¦n

¦³¤T­Ó¤u§@ªí,²Ä¤@¬O§ë«H,²Ä¤G¬O¥~¸ê,²Ä¤T¬O¥D¤O,main¤u§@ªí¬O¾ã¦X¤T­Ó¤u§@ªíªº¸ê®Æ

¾ã¦X¶R¶W¤Î½æ¶Wªº¸ê®Æ,main¤u§@ªí¤¤,AÄ欰ªÑ²¼¦WºÙ,BÄ欰¦¬½L»ù,CÄ欰º¦¶^

D~FÄ欰¶R¶WÄæ,DÄ欰§ë«H,EÄ欰¥~¸ê,FÄ欰¥D¤O,
I~KÄæ½æ¶WÄæ,IÄ欰§ë«H,JÄ欰¥~¸ê,KÄæ¥D¤O

±N¦UªÑ²¼ªº¶R½æ¶Wªº­È,¾ã¦X¦ÜÂkÃþªºÄæ¦ì¤¤,¥H¤j¦Ü¤p±Æ§Ç

·PÁ¦U¦ì«e½úªº¸Ñµª


1213.rar (16.24 KB)

¤U¸ü¦¸¼Æ: 19

2010-12-14 03:01

GBKEE

¦^´_ 1# aok669
   

1. Sub Ex()
   
2.     Dim D As Object, Sh As Worksheet, R As Range, i%, S$, ii
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     For Each Sh In Sheets
   
5.         If Sh.Name <> "main" Then
   
6.             With Sh
   
7.                 i = .Range("a1").End(xlDown).Row
   
8.                 For Each R In .Range("A3:A" & i & ",F3:F" & i)
   
9.                     S = .Name & .Cells(1, R.Column) & R(1, 2)
   
10.                     D(S) = Array(R(1, 3), R(1, 4), R(1, 5))
    
11.                 Next
    
12.             End With
    
13.         End If
    
14.     Next
    
15.     With Sheets("MAIN")
    
16.         i = .Range("a" & Rows.Count).End(xlUp).Row
    
17.         For Each R In .Range("A3:A" & i)
    
18.             For ii = 4 To 6
    
19.                 S = .Cells(2, ii) & .[D1] & R
    
20.                 If D.exists(S) Then
    
21.                     If R(1, 2) = "" Then R(1, 2) = D(S)(1)
    
22.                     If R(1, 3) = "" Then R(1, 3) = D(S)(2)
    
23.                     R(1, ii) = D(S)(0)
    
24.                 Else
    
25.                     R(1, ii) = ""
    
26.                 End If
    
27.             Next
    
28.             For ii = 9 To 11
    
29.                 S = .Cells(2, ii) & .[i1] & R
    
30.                 If D.exists(S) Then
    
31.                     If R(1, 2) = "" Then R(1, 2) = D(S)(1)
    
32.                     If R(1, 3) = "" Then R(1, 3) = D(S)(2)
    
33.                     R(1, ii) = D(S)(0)
    
34.                 Else
    
35.                     R(1, ii) = ""
    
36.                 End If
    
37.             Next
    
38.             If Application.Sum(R(1, 4).Resize(, 3), R(1, 9).Resize(, 3)) = 0 Then
    
39.                 R(1, 2) = ""
    
40.                 R(1, 3) = ""
    
41.             End If
    
42.         Next
    
43.     End With
    
44. End Sub

½Æ»s¥N½X

aok669

·PÁÂGBKEE¤j¤j©âªÅ¦^µª°ÝÃD

¦b main¤¤,¤p§Ì¥u¬O¥ý±N4°¦ªÑ²¼ªºÅ޿襴¤J,
¦b§ë«H,¥~¸ê,¥D¤Oªº¤À­¶,¦@¦³100¦h°¦­n¤ÀÃþ

¨Ò¦p 2409¤Í¹F ¦b§ë«H¬O½æ¶W-522,¦b¥~¸ê¬O¶R¶W8647,¦b¥D¤O«hµL¶R¶W»P½æ¶Wªº¬ö¿ý

©Ò¥H¦bmainÅã¥Ü¦p¹Ï

¦¬½L,º¦¶^½Ðª½±µ½Æ»s

2010-12-15 10:55

¤j¤j±z¥i¥H±N +¥¿­Èµø¬° ¶R¶W ¡A  -­t­Èµø¬°½æ¶W,³o¼ËÅÞ¿è¤ñ¸û¦n¥N¤J

±Æ§Ç¤è­±,¶R¶W ¥¿­È¶V°ª,±Æ¶V¤W­± , ½æ¶W ­t­È¶V°ª±Æ¶V¤W­±

½Ð«ô°U¤j¤j¤F

GBKEE

¦^´_ 3# aok669
ªÑ¥«§Ú¤£¤ÓÀ´½Ð°Ý,¹Ï¤@: 2409¤Í¹Fªº§ë«H½æ¶W-522 ,¦p¦óÅܦ¨ ¹Ï¤G:Âà¨ì¥~¸ê½æ¶W-522

aok669

¦^´_ 4# GBKEE


    ¹ï¤£°_, GBKEE ¤j¤j,½Ð¥H¹Ï¤@(³Ì¤W­±)¬°·Ç,¹Ï¤G¬O§Ú¤£ª¾¦p¦ó§R°£,©Ò¥H´N¿ò¯d¤U¨Ó¤F,·PÁÂ

Hsieh

¤£À´©Ò¿×±Æ§Çªº³W«h
³æ¯Â±N3ªí¸ê®ÆÂk¦Ü1ªí¸Õ¸Õ

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. Dim A As Range, B As Range, C As Range, r&
   
5. For Each sh In Sheets(Array("§ë«H", "¥~¸ê", "¥D¤O"))
   
6. With sh
   
7. r = 3
   
8.    Do Until .Cells(r, 2) = ""
   
9.    Set A = .Cells(r, 2)
   
10.    Set B = .Cells(r, 7)
    
11.       d(A.Text) = Array(A.Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
    
12.       d1(A & sh.Name & .[A1]) = A.Offset(, 1).Value
    
13.       d1(B & sh.Name & .[F1]) = B.Offset(, 1).Value
    
14.       r = r + 1
    
15.    Loop
    
16. End With
    
17. Next
    
18. With Sheets("main")
    
19. .[A3:F65536,I3:K65536] = ""
    
20. .[A3].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
    
21. r = 3
    
22. For Each ky In d.keys
    
23.    For Each i In Array(4, 5, 6, 9, 10, 11)
    
24.       Set A = .Cells(r, i)
    
25.       Set B = .Cells(2, i)
    
26.       Set C = .Cells(1, i).MergeArea(1)
    
27.       A.Value = d1(ky & B & C)
    
28.    Next
    
29.    r = r + 1
    
30. Next
    
31. End With
    
32. End Sub

½Æ»s¥N½X

aok669

¦^´_ 6# Hsieh


·PÁ¤j¤jªº¦^ÂÐ

¤j¤j¤w¸g§¹¦¨¤F¤@¥b,¤£¹L

¶R¶Wªº³¡¥÷,§ë«H»P¥~¸ê»P¥D¤O§¹¥þ¥¿½Tªº,
½æ¶Wªº³¡¥÷,§ë«H,¥~¸ê,¥D¤O,³£¥¼¤ÀÃþ

½Ð¤j¤j¬Ýµ{¦¡°õ¦æ«áªºµe­±

2010-12-15 16:51

¨Ò¦p¥¼Ãþ¶i¥hªº¦³ 2801 ¹ü»È

2010-12-15 16:59

½æ¶W¦A«ô°U¤j¤j±z¤F




¤j¤j¦A«ô°U±z¤F

Hsieh

¦^´_ 7# aok669

1. Sub Ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. Dim A As Range, B As Range, C As Range, r&
   
5. For Each sh In Sheets(Array("§ë«H", "¥~¸ê", "¥D¤O"))
   
6. With sh
   
7. r = 3
   
8.    Do Until .Cells(r, 2) = ""
   
9.    Set A = .Cells(r, 2)
   
10.    Set B = .Cells(r, 7)
    
11.       d(A.Text) = Array(A.Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
    
12.       d(B.Text) = Array(B.Value, B.Offset(, 2).Value, B.Offset(, 3).Value) '¥[¤J³o¦æ
    
13.       d1(A & sh.Name & .[A1]) = A.Offset(, 1).Value
    
14.       d1(B & sh.Name & .[F1]) = B.Offset(, 1).Value
    
15.       r = r + 1
    
16.    Loop
    
17. End With
    
18. Next
    
19. With Sheets("main")
    
20. .[A3:F65536,I3:K65536] = ""
    
21. .[A3].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
    
22. r = 3
    
23. For Each ky In d.keys
    
24.    For Each i In Array(4, 5, 6, 9, 10, 11)
    
25.       Set A = .Cells(r, i)
    
26.       Set B = .Cells(2, i)
    
27.       Set C = .Cells(1, i).MergeArea(1)
    
28.       A.Value = d1(ky & B & C)
    
29.    Next
    
30.    r = r + 1
    
31. Next
    
32. End With
    
33. End Sub

½Æ»s¥N½X

aok669

¦^´_ 8# Hsieh


     ·PÁ¤j¤jªº¦^ÂÐ