[µo°Ý] ¦r¨å¨Ï¥Î°ÝÃD

jesscc

¤u§@¬O³o¼Ëªº
¥Î¤u§@ªí2ªº"PN"Äæ¦ì¥h¸ò¤u§@ªí1ªº"PN"Äæ¦ì¤ñ¹ï¡A¦pªG¦³¤ñ¹ï¨ì¬Û¦Pªº¡A´N§â¨º­ÓPN±qCÄæ¨ìLÄ檺¼Æ­È¶Ç¦^¨ì¤u§@ªí2¬Û¦PPNªº¹ïÀ³¦ì¸m¡Aµ{¦¡¤@ª½¨S¿ìªk¥¿½T°õ¦æ¡A¤£¹L¹ê¦b§ä¤£¨ì­þ¸Ì¦³°ÝÃD¡A¯àÀ°¦£¬Ý¤@¤U°ÝÃD¥X¦b­þ¶Ü?
test.rar (13.41 KB)

¤U¸ü¦¸¼Æ: 27

2018-10-20 16:46

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:

¤U¸ü (113.75 KB)

2023-5-16 14:01

µ²ªGªí°õ¦æ«e:

¤U¸ü (120.89 KB)

2023-5-16 14:02

°õ¦æµ²ªG:

¤U¸ü (131.05 KB)

2023-5-16 14:02

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&, j&, Q&
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
With ¤u§@ªí1: Arr = Range(.[L6], .[B65536].End(3)): End With
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Arr):  Y(Arr(i, 1)) = i: Next
'¡ô¥OArr°}¦Cªº°j°é¦C²Ä1Äæ­È·íkey,item¬Oi°j°éÅܼÆ(¥H¦r¨å¬ö¿ýÁä­È»P¦C¸¹)
With ¤u§@ªí2
   .[F7].Resize(1000, 10).ClearContents
   '¡ô¥Oµ²ªGªí²M°£Àx¦s®æµ²ªG
   Brr = Range(.[E7], .[E65536].End(3))
   '¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
End With
ReDim Crr(1 To UBound(Brr), 1 To 10)
'¡ô¥O«Å§iCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr,¾î¦V½d³ò¯Á¤Þ¸¹1~10
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é
   Q = Y(Brr(i, 1))
   '¡ô¥OQÅܼƱa¥XBrr°}¦C1ÄæÃöÁä¦r¦bY¦r¨å¸Ì¬ö¿ýªºArr°}¦C¦C¸¹
   If Q = 0 Then Crr(i, 1) = "¬dµL¦¹PN": GoTo i01
   '¡ô¦pªGQÅܼƬO 0,¥NªíArr°}¦C¸ÌµL¦¹Áä,¥u¦bµù°OÄæ¦ì°µµù°O
   For j = 1 To 10: Crr(i, j) = Arr(Q, j + 1): Next
   '¡ô³]°j°é±NArr°}¦C­È±a¤JCrr°}¦C
i01: Next
[¤u§@ªí2!F7].Resize(UBound(Crr), 10) = Crr
'¡ô¥OCrr°}¦C­È±q[¤u§@ªí2!F7]¶}©l,­Ë¤JÀx¦s®æ¤¤
Set Y = Nothing: Erase Arr, Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

jesscc

¦^´_ 9# Kubi
ÁÂÁÂK¤j¡A¤F¸Ñ¤F¡C

Kubi

¦^´_ 3# jesscc

­Y¨S¦³«Å§iOption Base 1ªº¸Ü¡A«h©³¤UªºDim Ar(10)·|¥]§tAr(0)¡BAr(1)¡BAr(2)¡BAr(3)...¡BAr(10)¦@¦³11­Ó°}¦C¤¸¯À¡C
­Y«Å§iOption Base 1ªº¸Ü¡A«hAr(10)°}¦C¥u¥]§tAr(1)¡BAr(2)¡BAr(3)...¡BAr(10)¡A10­Ó°}¦C¤¸¯À¡C
­YOption Base 1 ®³±¼ªº¸Ü¡A¾ã­Ó¸ê®Æ¶Ç¦^µ²ªG·|¦V¥k°¾¤@Äæ´N¬O³o­Ó¹D²z¡C

­ã´£³¡ªL

Sub Test2()
Dim Arr, Brr, xD, i&, j%, U&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¤u§@ªí1!L6], [¤u§@ªí1!B65536].End(xlUp))
For i = 1 To UBound(Arr):  xD(Arr(i, 1)) = i: Next

[¤u§@ªí2!F7:O2000].ClearContents
Brr = Range([¤u§@ªí2!O7], [¤u§@ªí2!E65536].End(xlUp))
For i = 1 To UBound(Brr)
    U = xD(Brr(i, 1)): Brr(i, 2) = "¬dµL¦¹PN": If U = 0 Then GoTo 101
    For j = 2 To 11: Brr(i, j) = Arr(U, j): Next
101: Next i
[¤u§@ªí2!E7:O7].Resize(UBound(Brr)) = Brr
End Sub

jackyq

¦^´_ 6# jesscc


    With Sheets("¤u§@ªí1")
Set D = CreateObject("Scripting.Dictionary")

For Each B In .Range(.[B6], .[B100].End(xlUp))
Dim Ar(10)
    For p = 1 To 10
    Ar(p) = B.Offset(, p).Value
    Next p
    D(B & "") = Ar
Next
End With








Dim Ar(10)  change as Dim Ar(1 To 10)

jesscc

B change as E
jackyq µoªí©ó 2018-10-21 07:38

¤w§ï¡A¥i¥¿±`°õ¦æ¡A¦ý§ÚªººÃ°Ý¬O¦pªG§â²Ä¤@¬q³o¥y "Option Base 1" ®³±¼¡A¾ã­Ó¸ê®Æ¶Ç¦^µ²ªG·|¦V¥k°¾¤@Äæ¡A§Ú¥uª¾¹D³o¬O°}¦C¯Á¤Þ¤U­­­Èªº°ÝÃD¡A¦pªG¦b¤£³]©w¤U­­­Èªº±¡§Î¤U¡A­n¦p¦ó§ï¼g­ì¨Óªº°}¦C±Æ¦C?

jackyq

B change as E

jackyq

¦^´_ 3# jesscc


    With Sheets("¤u§@ªí2")
.[F7:O1000].ClearContents
    For Each E In .Range(.[E7], .[E100].End(xlUp))
      If D.EXISTS(B & "") Then
      E.Offset(, 1).Resize(, 10) = D(B & "")
      Else: E.Offset(, 1) = "¬dµL¦¹ PN"
      End If
    Next
End With

jesscc

½Ð°ÝK¤j¡A§Ú¤§«e¨ä¥Lªº¤u§@¡A¦r¨åµ{¦¡¶}ÀY³£¨S¥[³o¬q "Option Base 1"¡A ±N°}¦C¯Á¤Þ­È¤U­­³]¬°1¡A¦ý³£¥i¥H¥¿±`°õ¦æ¡A¬°¤°»ò¦b³o¸Ì¨S¦³¥[´N·|°õ¦æ¿ù»~?