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

ii31sakura

¤£¦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ÁÂ

stillfish00

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

c_c_lai

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

¤U¸ü¦¸¼Æ: 4

2014-5-31 10:25

c_c_lai

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

¤U¸ü (27.71 KB)

2014-5-31 10:31

c_c_lai

¦^´_ 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

jiwen818

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

ii31sakura

¦^´_ 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 !.!

Andy2483

¦^´_ 5# c_c_lai


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

°õ¦æ«e:

¤U¸ü (112.51 KB)

2023-4-17 11:50

°õ¦æµ²ªG:

¤U¸ü (145.6 KB)

2023-4-17 11:50

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