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

[µo°Ý] ½Ð±Ð¦U¦ì«e½úvba Ãö©ó¨ú¤£­«´_­È°ÝÃD~

[µo°Ý] ½Ð±Ð¦U¦ì«e½úvba Ãö©ó¨ú¤£­«´_­È°ÝÃD~

¤£¦n·N«ä¡B½Ð°Ý¦U¦ì«e½ú¡B¤p§Ì¥Ø«eªº¸ê®Æ±¡ªp¦p¤U¡G

1. "A~C"Äæ¦ì¬°Á`¸ê®Æ¨Ó·½
2. "F~H"»P"J~K"Äæ¦ì¬°¤p§Ì·Q­n¾ã²z¥X¨Óªº¸ê®Æ¡B¤p§Ì·Q­n±NÁ`¸ê®Æ¨Ó·½¾ã²z¦¨¹³"F~H"»P"J~K"ªºµ²ªG(¤£§t­«´_©Ê¸ê®Æ²M³æ)¡A
     ¥D­n¥Ø«e¥d¦b³o¤@Ãä(¤p§Ì¤]ª¦¤å§ä¤F¨ä¥¦¨Ò¤l¡B¥Ø«e¥u§ä¨ì³æ¤@Äæ¦ì¾ã²z¥X¤£§t­«´_©Ê¤èªk..¦ý¹³¦¹ºØ¦hÄæ¦ì¤£ª¾¦p¦óµÛ¤â..)¡A
     ¬G©ó¦¹½Ð±Ð¤j¤j­Ì¤p§Ì¸Ó¦p¦óµÛ¤â¡B¤§«á¤p§Ì±N¨Ì"­Ü®w§O²M³æ"¤À§O¥h¶}·ssheet»P±N"«~¦W"¨Ì²M³æ¶ñ¤J¡C


³Â·Ð¦U¦ì¤j¤j¤F~·PÁÂ

test²Î­p.rar (13.56 KB)

¦^´_ 1# ii31sakura
Excel2010
¿ï½d³ò¡A¸ê®Æ>¸ê®Æ¤u¨ã>²¾°£­«½Æ¡C

TOP

¦^´_ 1# ii31sakura
¸Õ¸Õ¬Ý¡I
test²Î­p.rar (17.92 KB)

TOP

¦^´_ 1# ii31sakura
°õ¦æµ²ªG¡G

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2014-5-31 10:52 ½s¿è

¦^´_ 1# ii31sakura
¨S¯d·N§A¤´¬O¤p¾Ç¥Íµ¥¯Å¡A¬OµLªk¤U¸üªº¡C
©Ò¥H±Nµ{¦¡½X¶K¤W¡G
  1. Sub Ex()
  2.     Dim ²Ä¤@ºØ²Õ¦X As Object, ²Ä¤GºØ²Õ¦X As Object, rng As Range
  3.    
  4.     Set ²Ä¤@ºØ²Õ¦X = CreateObject("Scripting.Dictionary")
  5.     Set ²Ä¤GºØ²Õ¦X = CreateObject("Scripting.Dictionary")
  6.    
  7.     With Sheets("DATA")
  8.         '  .[F:L].ClearContents                         '  «O¯d½Æ»s¼ÐÃD
  9.         .[F12:L65535].ClearContents
  10.         For Each rng In .Range([A2], [A2].End(xlDown))   '  ¨C¤é
  11.             If IsEmpty(²Ä¤@ºØ²Õ¦X(rng.Value & rng.Offset(, 1).Value & rng.Offset(, 2).Value)) Then               '  ¼g¤J¦r¨å
  12.                 ²Ä¤@ºØ²Õ¦X(rng.Value & rng.Offset(, 1).Value & rng.Offset(, 2).Value) = Array(rng.Value, rng.Offset(, 1).Value, rng.Offset(, 2).Value, Val(rng.Offset(, 3).Value))
  13.             Else
  14.                 ²Ä¤@ºØ²Õ¦X(rng.Value & rng.Offset(, 1).Value & rng.Offset(, 2).Value) = Array(rng.Value, rng.Offset(, 1).Value, rng.Offset(, 2).Value, ²Ä¤@ºØ²Õ¦X(rng.Value & rng.Offset(, 1).Value & rng.Offset(, 2).Value)(3) + Val(rng.Offset(, 3).Value))
  15.             End If
  16.             
  17.             If IsEmpty(²Ä¤GºØ²Õ¦X(rng.Offset(, 1).Value & rng.Offset(, 2).Value)) Then               '  ¼g¤J¦r¨å
  18.                 ²Ä¤GºØ²Õ¦X(rng.Offset(, 1).Value & rng.Offset(, 2).Value) = Array(rng.Offset(, 1).Value, rng.Offset(, 2).Value, Val(rng.Offset(, 3).Value))
  19.             Else
  20.                 ²Ä¤GºØ²Õ¦X(rng.Offset(, 1).Value & rng.Offset(, 2).Value) = Array(rng.Offset(, 1).Value, rng.Offset(, 2).Value, ²Ä¤GºØ²Õ¦X(rng.Offset(, 1).Value & rng.Offset(, 2).Value)(2) + Val(rng.Offset(, 3).Value))
  21.             End If
  22.         Next
  23.         
  24.         .[F12].Resize(²Ä¤@ºØ²Õ¦X.Count, 4) = Application.Transpose(Application.Transpose(²Ä¤@ºØ²Õ¦X.items))   '  ¼g¤J¤u§@ªí
  25.         .[J12].Resize(²Ä¤GºØ²Õ¦X.Count, 3) = Application.Transpose(Application.Transpose(²Ä¤GºØ²Õ¦X.items))   '  ¼g¤J¤u§@ªí
  26.     End With
  27.     '  ÄÀ¥Xª«¥óÅܼÆ
  28.     Set ²Ä¤@ºØ²Õ¦X = Nothing
  29.     Set ²Ä¤GºØ²Õ¦X = Nothing
  30. End Sub
½Æ»s¥N½X

TOP

¿ï½d³ò¡A¸ê®Æ>¸ê®Æ¤u¨ã>²¾°£­«½Æ¡C

TOP

¦^´_ 5# c_c_lai

·PÁÂc_c_lai ¤j¤j»P stillfish00¤j¤jªº±Ð¾É¡Astillfish00¤j¤jªº¤è¦¡¦b²Ä¤@¦¸¾ã²z¸ê®Æ®ÉÆZ¦³¥Îªº¡A
¥u¬O¤p§Ìªº¸ê®Æ¬O¤Ñ¤Ñ»Ý§ó·sªº¡B©Ò¥H·|¤ñ¸û³Â·Ð¤@ÂI¡B¤]ÁÂÁÂc_c_lai ¤j¤jªº¼ö¤ßÀ°¦£¡A
¤j¤j©Ò´£¨Ñªºµ{¦¡½X¹ï¤p§Ì¨Ó»¡À°§UÆZ¤jªº¡A©Ò¥H¦b¦¹ÁÂÁ¤j®aÅo !.!

TOP

¦^´_ 5# c_c_lai


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

°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100, 1 To 7), Y, R1&, R2&, N&, i&, j&, T(4)
Dim xR As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([D1], [A1].End(xlDown)): Brr = xR
For i = 2 To UBound(Brr)
   For j = 1 To 4: T(j) = Brr(i, j): Next
   If i = 2 Then
      R1 = 1: R2 = 1
      For j = 1 To 4: Crr(1, j) = Brr(1, j): Next
      For j = 5 To 7: Crr(1, j) = Brr(1, j - 3): Next
   End If
   T(0) = "­Ü«~|" & T(2) & "|" & T(3)
   If Y(T(0)) = "" Then
      R2 = R2 + 1
      Y(T(0)) = R2
      For j = 5 To 7: Crr(R2, j) = T(j - 3): Next
      Else
         N = Y(T(0)): Crr(N, 7) = Crr(N, 7) + T(4)
   End If
   T(0) = "¤é|" & T(1) & "|" & T(0)
   If Y(T(0)) = "" Then
      R1 = R1 + 1: Y(T(0)) = R1
      For j = 1 To 4: Crr(R1, j) = T(j): Next
      Else
         N = Y(T(0)): Crr(N, 4) = Crr(N, 4) + T(4)
   End If
Next
With Rows(UBound(Brr) + 2 & ":65536")
   .Clear
   With .Item(1).Resize(R1 + 1, 7)
      .Value = Crr
      With Intersect(.Cells, [A:D])
         .Sort KEY1:=.Item(1), Order1:=1, _
         Key2:=.Item(2), Order2:=1, _
         Key3:=.Item(3), Order2:=1, Header:=1
      End With
      With Intersect(.Cells, [E:G])
         .Sort KEY1:=.Item(1), Order1:=1, _
         Key2:=.Item(2), Order2:=1, Header:=1
      End With
   End With
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

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