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

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

scripting.dictionary¨Ï¥ÎºÃ°Ý

½Ð±Ð¦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

¶Å¨é³¡¦ìµû»ù.rar (29.87 KB)

¤p¤Hª«

TOP

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

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

TOP

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

¥»©«³Ì«á¥Ñ jasonwu0114 ©ó 2014-1-9 17:25 ½s¿è

§Ú¦³2­ÓÀÉ®×
A(¥æ©öÁ`ªí) ³¡¦ì¸Õºâªí-³Â»¶-1030108.rar (14.77 KB)
B(¥æ©ö­û­Ó¤H) ªÑÅv§ë¸ê1030107--³Â»¶.rar (17.26 KB)
·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. 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. For Each bt In Range("a6", .Range("a6").End(xlDown))
  14.   With bt
  15.   
  16.    If .Offset(, 4) <> "" Then
  17.          
  18.          If .Offset(, 15) = "¥æ©ö­û1" Then
  19.             
  20.             e(1)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  21.             
  22.          ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
  23.             
  24.             e(2)(.Value) = Array(.Offset(, 4).Value, .Offset(, 5).Value)
  25.             
  26.          End If
  27.          
  28.    End If
  29.    
  30.    If .Offset(, 7) <> "" Then
  31.    
  32.          If .Offset(, 15) = "¥æ©ö­û1" Then
  33.          
  34.             e(3)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  35.             
  36.          ElseIf .Offset(, 15).Value = "¥æ©ö­û2" Then
  37.          
  38.             e(4)(.Value) = Array(.Offset(, 7).Value, .Offset(, 9).Value)
  39.             
  40.          End If
  41.          
  42.    End If
  43.    
  44.   End With
  45. Next

  46. End With


  47. Workbooks("ªÑÅv§ë¸ê1030107--³Â»¶.xls").Activate

  48. With Sheets("¥æ©ö­û1")

  49. Set rng = Sheets("¥æ©ö­û1").Range("a10")

  50.    Do While rng <> ""
  51.    s = Val(rng)
  52.    
  53.          If e(1).exists(s) Then
  54.          
  55.             .Offset(, 6) = e(1)(s)(0)
  56.             .Offset(, 7) = e(1)(s)(1)
  57.          End If
  58.          
  59.          If e(3).exists(rng) Then
  60.             .Offset(, 8) = e(3)(rng)(0)
  61.             .Offset(, 10) = e(3)(rng)(1)
  62.          End If
  63.          
  64.       Set rng = rng.Offset(1)
  65.    Loop
  66.    
  67. End With


  68. End Sub
½Æ»s¥N½X
¤p¤Hª«

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-1-12 08:01 ½s¿è

¦^´_ 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
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : §ïÅܦۤv¬O¦Û±Ï¡A¼vÅT§O¤H¬O±Ï¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD