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

[µo°Ý] ½Ð°ÝVBA Excel °}¦Cªº°ÝÃD?

[µo°Ý] ½Ð°ÝVBA Excel °}¦Cªº°ÝÃD?

¥»©«³Ì«á¥Ñ pipi1968 ©ó 2016-3-15 21:04 ½s¿è

§Ú¦³­Ó¤Gºû°}¦C¦p¤U:
"AA", "yes", "Cr", 111, 222
"BB", "No", "Dr" , 333, 444
"CC", "yes", "Bl", 111, 222
"AA", "yes", "Cr", 222, 333
"CC", "yes", "Bl", 333, 555
"CC", "yes", "Bl", 222, 111
"BB", "No", "Dr" , 444, 222
....

­ì«h¤W"AA", ·|·f°t"yes", "Cr"¡F"BB",·|·f°t"No", "Dr"¡F"CC", ·|·f°t"yes", "Bl"
¦pªG­n®Ú¾Ú²Ä1Äæ("AA"¡B"BB"¡B"CC"),±a¥X²Ä2Äæ("yes" or "No")¡B±a¥X²Ä¢²Äæ("Cr"¡B "Dr"¡B "Bl")¡A¨Ã¥[Á`²Ä4Äæ¡B²Ä5Äæ
²£¥Í·s°}¦C¦p¤U
"AA", "yes", "Cr", 333, 555
"BB", "No", "Dr" , 777, 666
"CC", "yes", "Bl" , 777 888
....

½Ð°ÝVBA Excel ¸Ó¦p¦ó¼g?
·PÁ¤j®aªºÀ°¦£

¦^´_ 8# ­ã´£³¡ªL


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

°õ¦æ«e:


°õ¦æµ²ªG:



Sub TEST()
Dim R&, N&, Arr, Brr, xD, T$, i&
'¡ô«Å§iÅܼÆ
Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
'¡ô¥Oµ²ªGªí¼ÐÃD¦C¥H¤U¦³¨Ï¥Îªº¦C§R°£
Arr = Sheets("Sheet1").UsedRange
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥Hªí1¦³¨Ï¥Î®æÂX®i³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Brr(1 To UBound(Arr), 1 To 8)
'¡ô¥OBrrÅܼƬO ¤GºûªÅ°}¦C(Áa¦V½d³ò¦PArr°}¦C,¾î¦V1~8)
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxDÅܼƬO ¦r¨å
For i = 3 To UBound(Arr)
'¡ô³]¶¶°j°é
    If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
    '¡ô¦pªG²Ä(4,7,8,10)Äæ°j°é¦CArr°}¦C­È¥ô¤@­Ó¬OªÅªº,´N¸õ¨ì¼Ð¥Ü 101¦ì¸mÄ~Äò°õ¦æ
    T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
    '¡ô¥OTÅܼƬOArr°}¦C­Èªº²Õ¦X¦r¦ê
    R = xD(T)
    '¡ô¥ORÅܼƬO TÅܼƬdxD¦r¨åitem­È
    If R = 0 Then
    '¡ô¦pªGRÅܼƬO 0(ªì©l­È:¥NªíTÅܼƥi¯à¬Oªì¦¸¯Ç¤J¦r¨å)
       N = N + 1: R = N: xD(T) = N
       '¡ô¥ONÅܼƲ֥[1,¥ORÅܼƬO NÅܼƭÈ(©ñµ²ªG¦bBrr°}¦Cªº¦C¸¹),
       '¥O¦bxD¦r¨åªºTÅܼÆkey,¹ïÀ³ªºitemÅܦ¨ NÅܼƭÈ

       Brr(R, 1) = Arr(i, 7)
       Brr(R, 2) = Arr(i, 8)
       Brr(R, 3) = Arr(i, 10)
       Brr(R, 7) = Arr(i, 4)
       Brr(R, 8) = Split(T, "|")(0)
       '¡ô¥OArr°}¦C­È¼g¤JBrr°}¦C¤¤
    End If
    If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
    If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
    If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
    '¡ô¦pªGArr°}¦C­È½T»{¬O«D0ªº¼Æ­È? True´Nµ¹Brr°}¦C¥[Á`
101: Next i
If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
'¡ô¦pªGªí1¦³²Å¦X±ø¥óªº¸ê®Æ? ¬O´N¥O±qªí2ªº[A2]¶}©lªº½d³ò¼g¤JBrr°}¦C­È,
'¶W¹L½d³òªº°}¦C­È©¿²¤

End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ¦U¦ì°ª¤âªº«ü¾É¡A°ÝÃD¤w¸g¸Ñ¨M¤F

TOP

¥»©«³Ì«á¥Ñ pipi1968 ©ó 2016-3-16 12:40 ½s¿è
¦h±ø¥ó²Î­p, ¥i¥Î ¦r¨åÀÉ+°}¦C,
¤£¹L­þ´X­Ó±ø¥ó­n»¡²M·¡,
yn2 ¦pªG¦³y ¤Î n, ¬O§_µø¬°¤£¦P±ø¥ó?

index ...
­ã´£³¡ªL µoªí©ó 2016-3-16 11:02


­ì¥»¬O­n¥Î  ©m¦W   «~¶µ   ¦~«× 3­Ó­È§@¬°¥[Á`ª÷ÃB3 ©M ª÷ÃB7 ªº±ø¥ó
¦ý¤£ª¾­n¦p¦ó¼g¡A©Ò¥H´N§â³o3Äæ¦X¨Ö°_¨Ó§@¬°¥[Á`ª÷ÃB3 ©M ª÷ÃB7 ªº±ø¥ó
µ¥¼g¤Jexcel«á¡A¦A§â¥¦¤À¶}¼g¶i­ì¥»ªºÄæ¦ì

©Ò¥H ©m¦W¡B«~¶µ¡B¦~«×¦p¦³¤£¦P, §¡µø¬°¤£¦P±ø¥ó
yn2 ¦pªG¦³y ¤Î n, ¥u¬O­n§@¬°¥t¤@§PÂ_¤§¥Î¡A¤£µø¬°¤£¦P±ø¥ó

TOP

  1. Sub TEST()
  2. Dim R&, N&, Arr, Brr, xD, T$, i&
  3. Sheets("Sheet2").UsedRange.Offset(1, 0).EntireRow.Delete
  4. Arr = Sheets("Sheet1").UsedRange
  5. ReDim Brr(1 To UBound(Arr), 1 To 8)
  6. Set xD = CreateObject("Scripting.Dictionary")
  7. For i = 3 To UBound(Arr)
  8.     If Arr(i, 4) = "" Or Arr(i, 7) = "" Or Arr(i, 8) = "" Or Arr(i, 10) = "" Then GoTo 101
  9.     T = Arr(i, 7) & "<" & Arr(i, 10) & ">" & Arr(i, 8) & "|" & Arr(i, 4)
  10.     R = xD(T)
  11.     If R = 0 Then
  12.        N = N + 1: R = N: xD(T) = N
  13.        Brr(R, 1) = Arr(i, 7)
  14.        Brr(R, 2) = Arr(i, 8)
  15.        Brr(R, 3) = Arr(i, 10)
  16.        Brr(R, 7) = Arr(i, 4)
  17.        Brr(R, 8) = Split(T, "|")(0)
  18.     End If
  19.     If Val(Arr(i, 14)) <> 0 Then Brr(R, 4) = Brr(R, 4) + Arr(i, 14)
  20.     If Val(Arr(i, 21)) <> 0 Then Brr(R, 5) = Brr(R, 5) + Arr(i, 21)
  21.     If Val(Arr(i, 22)) <> 0 Then Brr(R, 6) = Brr(R, 6) + Arr(i, 22)
  22. 101: Next i
  23. If N > 0 Then [Sheet2!A2].Resize(N, 8) = Brr
  24. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# pipi1968


    ar(0)(0)¬O°}¦C¤¤ªº°}¦C¡A´N¬O°}¦C¸Ì­±¥]µÛ°}¦C¡A¥~¼hªº°}¦C¬°ar(0)¡Aar¬°¦WºÙ²Ä¤@­Ó(0)¬°¦ì§}
¡A¦Ó¤º¼hªº°}¦C¬°ar(0)(0)¡Aar(0)¬°¦WºÙ´NÃþ¦üar1¡Bar2ªº¨Ï¥Î¡A«h²Ä¤G­Ó(0)¬°¦ì§}¡C
¨Ì¦¹Ãþ±À¥]¦hºû°}¦C¤]¥i¥H¥]¦hµÛ¦hºû°}¦C¡A¦par(i,j)(k,l)

a1 = [a1:b10]
a2 = [d1:e10]
ar = Array(a1, a2)
arr = Array(ar)

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2016-3-16 11:04 ½s¿è

¦h±ø¥ó²Î­p, ¥i¥Î ¦r¨åÀÉ+°}¦C,
¤£¹L­þ´X­Ó±ø¥ó­n»¡²M·¡,
yn2 ¦pªG¦³y ¤Î n, ¬O§_µø¬°¤£¦P±ø¥ó?

index ¨ºÄæ°µ¤°»ò¥Î?

TOP

¦^´_ 4# pipi1968

§A¥Ø«e°}¦C«Å§i¤è¦¡¥i¥H°Ñ¦Ò Sub ex2()
   


Sub ex()
    Set d = CreateObject("Scripting.Dictionary")
    ar = Array(Array("AA", "yes", "Cr", 111, 222), _
               Array("BB", "No", "Dr", 333, 444), _
               Array("CC", "yes", "Bl", 111, 222), _
               Array("AA", "yes", "Cr", 222, 333), _
               Array("CC", "yes", "Bl", 333, 555), _
               Array("CC", "yes", "Bl", 222, 111), _
               Array("BB", "No", "Dr", 444, 222))

    For i = LBound(ar) To UBound(ar)
        If Not d.exists(ar(i)(0)) Then
            d(ar(i)(0)) = ar(i)
        Else
            a = d(ar(i)(0))
            a(3) = a(3) + ar(i)(3)
            a(4) = a(4) + ar(i)(4)
            d(ar(i)(0)) = a
        End If
    Next
    [a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
    [a9].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub



Sub ex2()
    Set d = CreateObject("Scripting.Dictionary")
    ar = [A1:E7]

    For i = LBound(ar) To UBound(ar)
        If Not d.exists(ar(i, 1)) Then
            d(ar(i, 1)) = Array(ar(i, 1), ar(i, 2), ar(i, 3), ar(i, 4), ar(i, 5))
        Else
            a = d(ar(i, 1))
            a(3) = a(3) + ar(i, 4)
            a(4) = a(4) + ar(i, 5)
            d(ar(i, 1)) = a
        End If
    Next
    '    [a1].Resize(7, 5) = Application.Transpose(Application.Transpose(ar))
    [a13].Resize(d.Count, 5) = Application.Transpose(Application.Transpose(d.Items))
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¥t¥~½Ð±Ð¤@¤U¡A¦b§ÚªºÀɮפ¤¡A§Ú¥i¥H¥Îar(0,0)ªº»yªk¡A¥s¥X¨ä­È
¦ý¥Îar(0)(0)´N¤£¦æ¡A³o¬O¤°»ò­ì¦]?

TOP

¥»©«³Ì«á¥Ñ pipi1968 ©ó 2016-3-16 00:59 ½s¿è

ÁÂÁ«ü±Ð
¦ý®M¥Î¨ì§Úªº¸ê®Æ«o¥X²{ "°}¦C¯Á¤Þ¶W¥X½d³ò"ªº°T®§
       If Not d.exists(ar(i)(0)) Then
¤£ª¾°ÝÃD¨º¸Ì¦³°ÝÃD
·Ð½Ð¦A«ü¾É
ÁÂÁÂ

PS:ªþ¤W§Úªº´ú¸ÕÀÉ®×(¤w¼g¦nSheet1 ¸ê®Æ Ū¶i arªºµ{¦¡½X)
§Ú´ú¸ÕªºÀÉ®×, ¦n¹³¤£¤ä´©ar(0)(0)³oºØ¼gªk
¦ý¦pªG¥u°õ¦æ§Aªºµ{¦¡½X¡A¤S¥i¥H°õ¦æ

VBA-1.rar (25.15 KB)

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¯Ê¤fªºªM¤l¡A¦pªG´«¤@­Ó¨¤«×¬Ý¥¦¡A¥¦¤´µM¬O¶êªº¡C
ªð¦^¦Cªí ¤W¤@¥DÃD