[µo°Ý] ¦r¨åª«¥óKEYªº°ÝÃD

jasonwu0114

½Ð±Ð¦U¦ì°ª¤â
§Ú·Q§âsheet1(¤u§@ªí1)¤¤³¡¤À¸ê®Æ
©ñ¤J¦r¨åª«¥óD(1)  ¥ÎAÄ檺¶Å¨é¥N½X·íKEY
µM«á¨Ì¶Å¨é¥N½X
¶K¤JSheets("¶Å¨é-¤w¥æ³Î³¡¦ì(¥x¹ô)")

¥i¬O°õ¦æ¨ì  .Offset(, 8) = D(1)(rng1.Value)(0)¥X²{¿ù»~

°õ¦æ¶¥¬q¿ù»~"13"
«¬ºA¤£²Å¦X

½Ð°Ý
1.­þ¸Ì¥X°ÝÃD¤F??
2.µ{¦¡¥i¥H¼gªº¦A²¤Æ¤@¨Ç¶Ü??

·P®¦

Sub ¶Å¨é¶K()
Dim rng As Range, rng1 As Range, TP As Range, TP1 As Range
Dim D(1) As Object

Set D(1) = CreateObject("scripting.dictionary")

Sheets("¤u§@ªí1").Select
With Range("a1:a50")
     Set TP = .Find(what:="¥æ©ö³¡¦ì", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
End With
Set rng = TP.Offset(2)
Do While rng <> ""
  With rng
     D(1)(rng.Value) = Array(Val(.Offset(, 8)), Val(.Offset(, 9)), Val(.Offset(, 10)), Val(.Offset(, 11)), Val(.Offset(, 12)))
  
  End With
   Set rng = rng.Offset(1)
Loop

Sheets("¶Å¨é-¤w¥æ³Î³¡¦ì(¥x¹ô)").Select

With Range("a1:a50")
     Set TP1 = .Find(what:="¥æ©ö³¡¦ì", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
End With
Set rng1 = TP1.Offset(1)
Do While rng1 <> ""
  With rng1
   .Offset(, 8) = D(1)(rng1.Value)(0)         '³o¸Ì¥X²{¿ù»~
  .Offset(, 9) = D(1)(rng1.Value)(1)
     .Offset(, 10) = D(1)(rng1.Value)(2)
     .Offset(, 11) = D(1)(rng1.Value)(3)
     .Offset(, 12) = D(1)(rng1.Value)(4)
  End With
   Set rng1 = rng1.Offset(1)
Loop

End Sub

Hsieh

¦^´_ 1# jasonwu0114
¨º¬O¦]¬°¥æ©ö³¡¦ìªº¦WºÙ¤£¦P©Ò­P¤u§@ªí1ªºA02110¦h¤F¤@­ÓªÅ¥ÕÁä
°£¤F¤@¤@¼g¤Jªº¤èªk¡A¤]¥i¤@¦¸¼g¤J°}¦C
§AªºÄæ¦ì°¾²¾¶qÀ³¸Ó¬O5¤£¬O8§a?

1. Sub ¶Å¨é¶K()
   
2. Dim rng As Range, rng1 As Range, TP As Range, TP1 As Range
   
3. Dim D(1) As Object
   
4. Set D(1) = CreateObject("scripting.dictionary")
   
5. Sheets("¤u§@ªí1").Select
   
6. With Range("a1:a50")
   
7.      Set TP = .Find(what:="¥æ©ö³¡¦ì", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
   
8. End With
   
9. Set rng = TP.Offset(2)
   
10. Do While rng <> ""
    
11.   With rng
    
12.      D(1)(Trim(rng)) = Array(Val(.Offset(, 8)), Val(.Offset(, 9)), Val(.Offset(, 10)), Val(.Offset(, 11)), Val(.Offset(, 12)))
    
13.   End With
    
14.    Set rng = rng.Offset(1)
    
15. Loop
    
16. Sheets("¶Å¨é-¤w¥æ³Î³¡¦ì(¥x¹ô)").Select
    
17. With Range("a1:a50")
    
18.      Set TP1 = .Find(what:="¥æ©ö³¡¦ì", LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlNext)
    
19. End With
    
20. Set rng1 = TP1.Offset(1)
    
21. Do While rng1 <> ""
    
22.   With rng1
    
23.   If IsArray(D(1)(Trim(rng1))) Then
    
24.     '.Offset(, 5).Resize(, 5) = D(1)(Trim(rng1))'¤@¦¸¼g¤J°}¦C
    
25.     '¥H¤U¬°³v¤@¼g¤J
    
26.     .Offset(, 5) = D(1)(Trim(rng1))(0)
    
27.     .Offset(, 6) = D(1)(Trim(rng1))(1)
    
28.     .Offset(, 7) = D(1)(Trim(rng1))(2)
    
29.     .Offset(, 8) = D(1)(Trim(rng1))(3)
    
30.     .Offset(, 9) = D(1)(Trim(rng1))(4)
    
31.   End If
    
32.   End With
    
33.    Set rng1 = rng1.Offset(1)
    
34. Loop
    
35. End Sub

½Æ»s¥N½X

jasonwu0114

«D±`«D±`......·PÁÂ
©~µM¬OªÅ®æªº°ÝÃD
¤S¾Ç¨ì2©Û
Æg
³o¯u¬O­Ó¦n¦a¤è

jasonwu0114

§Ú¦³2­ÓÀÉ®×
A(¥æ©öÁ`ªí) ³¡¦ì¸Õºâªí-³Â»¶-1030108.rar (14.77 KB)

¤U¸ü¦¸¼Æ: 6

2014-1-9 16:18

B(¥æ©ö­û­Ó¤H) ªÑÅv§ë¸ê1030107--³Â»¶.rar (17.26 KB)

¤U¸ü¦¸¼Æ: 7

2014-1-9 16:18

·Q§Q¥Î¦r¨åª«¥ó
¥ÎªÑ²¼¥N¸¹·íKEY
±NAÀɮפ¤¦³¥æ©ö¤º®e¥á¤J
e(1):¶R-¥æ©ö­û1
e(2):¶R-¥æ©ö­û2
e(3):½æ-¥æ©ö­û1
e(4):½æ-¥æ©ö­û2

µM«á±Ò°ÊBÀÉ®×
sheet(¥æ©ö­û1)¥H²{¦³ªÑ²¼¥N¸¹·íKEY±qE1.E3§ä¸ê®Æ¶K¤W
sheet(¥æ©ö­û2)¥H²{¦³ªÑ²¼¥N¸¹·íKEY±qE2.E4§ä¸ê®Æ¶K¤W
(°²³]­n¶K¤Wªº¸ê®Æ¦bB¤w¸g¦³¸ÓÀɪѲ¼¥N¸¹)

¥i¬O´ú«Ü¤[¶K¤£¹L¥h
¦n¹³¬O¨âÃäªÑ²¼¥N¸¹ªº°ÝÃD
½Ð°Ý
1.­þ¸Ì¥X¤F°ÝÃD???
2.µ{¦¡¥i¥H¼gªº§óºë²¶Ü???
3.¦pªG­n¶K¤Wªº¬O·s¼Ðªº¦bBµLªÑ²¼¥N¸¹,­n¨ÌªÑ²¼¥N¸¹¶¶§Ç½Æ»s¤@¦C´¡¤Jµ{¦¡­n¦p¦ó¼g???

1. Sub Âà¶K¦ÜªÑÅv()
   
2. 'test
   
3. Dim bt As Range
   
4. Dim rng As Range
   
5. Dim s As String
   
6. Dim e(1 To 4) As Object
   
7. 
   
8. Set e(1) = CreateObject("scripting.dictionary")
   
9. Set e(2) = CreateObject("scripting.dictionary")
   
10. Set e(3) = CreateObject("scripting.dictionary")
    
11. Set e(4) = CreateObject("scripting.dictionary")
    
12. 
    
13. Workbooks("³¡¦ì¸Õºâªí-³Â»¶-1030108.xls").Activate
    
14. 
    
15. With Sheets("³¡¦ìªí")
    
16. 
    
17. 
    
18. For Each bt In Range("a6", .Range("a6").End(xlDown))
    
19.   With bt
    
20.   
    
21.    If .Offset(, 4) <> "" Then
    
22.          
    
23.          If .Offset(, 15) = "¥æ©ö­û1" Then
    
24.             
    
25.             e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
    
26.             
    
27.          ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
    
28.             
    
29.             e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
    
30.             
    
31.          End If
    
32.          
    
33.    End If
    
34.    
    
35.    If .Offset(, 7) <> "" Then
    
36.    
    
37.          If .Offset(, 15) = "¥æ©ö­û1" Then
    
38.          
    
39.             e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
    
40.             
    
41.          ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
    
42.          
    
43.             e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
    
44.             
    
45.          End If
    
46.          
    
47.    End If
    
48.    
    
49.   End With
    
50. Next
    
51. 
    
52. End With
    
53. 
    
54. 
    
55. Workbooks("ªÑÅv§ë¸ê1030107--³Â»¶.xls").Activate
    
56. 
    
57. With Sheets("¥æ©ö­û1")
    
58. 
    
59. Set rng = Sheets("¥æ©ö­û1").Range("a10")
    
60. 
    
61.    Do While rng <> ""
    
62.    s = Val(rng)
    
63.    
    
64.          If e(1).exists(s) Then
    
65.          
    
66.             .Offset(, 6) = e(1)(s)(0)
    
67.             .Offset(, 7) = e(1)(s)(1)
    
68.          End If
    
69.          
    
70.          If e(3).exists(rng) Then
    
71.             .Offset(, 8) = e(3)(rng)(0)
    
72.             .Offset(, 10) = e(3)(rng)(1)
    
73.          End If
    
74.          
    
75.       Set rng = rng.Offset(1)
    
76.    Loop
    
77.    
    
78. End With
    
79. 
    
80. 
    
81. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 1# jasonwu0114
¬Ý¤@¤Uµ¹ªºª`¸Ñ

1. Sub Âà¶K¦ÜªÑÅv()
   
2. Dim bt As Range
   
3. Dim Rng As Range
   
4. 'Dim s  As String   '¦r¦ê
   
5. Dim s  As Integer  '¼Æ¦r
   
6. Dim e(1 To 4) As Object
   
7. Set e(1) = CreateObject("scripting.dictionary")
   
8. Set e(2) = CreateObject("scripting.dictionary")
   
9. Set e(3) = CreateObject("scripting.dictionary")
   
10. Set e(4) = CreateObject("scripting.dictionary")
    
11. 'Workbooks("³¡¦ì¸Õºâªí-³Â»¶-1030108.xls").Activate
    
12. 'With Sheets("³¡¦ìªí")
    
13. With Workbooks("³¡¦ì¸Õºâªí-³Â»¶-1030108.xls").Sheets("³¡¦ìªí")
    
14.     For Each bt In .Range("a6", .Range("a6").End(xlDown))
    
15.         With bt
    
16.             If .Offset(, 4) <> "" Then
    
17.                 If .Offset(, 15) = "¥æ©ö­û1" Then
    
18.                     e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
    
19.                     '**** .Value -> Àx¦s®æ¬O¼Æ¦r  ********
    
20.                 ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
    
21.                     e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
    
22.                 End If
    
23.             End If
    
24.             If .Offset(, 7) <> "" Then
    
25.                 If .Offset(, 15) = "¥æ©ö­û1" Then
    
26.                     e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
    
27.                 ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
    
28.                     e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
    
29.                 End If
    
30.             End If
    
31.         End With
    
32.     Next
    
33. End With
    
34. Workbooks("ªÑÅv§ë¸ê1030107--³Â»¶.xls").Activate
    
35. With Sheets("¥æ©ö­û1")
    
36.     Set Rng = .Range("a10")
    
37.     Do While Rng <> ""
    
38.     's = Val(Rng)
    
39.     s = Rng       'Àx¦s®æ¬O¼Æ¦rª½±µ¤Þ¥Î (Rng.Value)
    
40.          If e(1).exists(s) Then
    
41.            Rng.Offset(, 6).Resize(, 2) = e(1)(s)
    
42.          End If
    
43.          If e(3).exists(Rng.Value) Then   ' Rng¬Oª«¥ó, ³o¸Ì­nµ¹Rng.Value(­È)
    
44.             Rng.Offset(, 8) = e(3)(Rng.Value)(0)
    
45.             Rng.Offset(, 10) = e(3)(Rng.Value)(1)
    
46.          End If
    
47.       Set Rng = Rng.Offset(1)
    
48.    Loop
    
49. End With
    
50. End Sub

½Æ»s¥N½X