[µo°Ý] ­«½Æ¤º®e®É¶¡¥[Á`¨Ã§R°£­«½Æ«O¯d°ß¤@­È

v03586

½Ð°Ý¦U¦ì«e½ú
§Ú¦³¼g¤@­Óµ{¦¡¥D­n¬O­n§PÂ_
°²³]¤£¦P¡yIÄæ¦ì¡zªº­È, ¦ý¬Û¦P¡yJÄæ¦ì¡zªº­È, «h¡yLÄæ¦ì¡z¬Û¥[¦b¡yMÄæ¦ì¡z(¥[Á`µ²ªG)
¨Ã«O¯d¤@­Ó¡yJÄæ¦ì¡zªº­È, §R°£­«½Æªº¡yJÄæ¦ì¡z

¦p¤U¹Ï, ¦ý¥Ø«e°õ¦æ¥X¨Óªºµ²ªG¦³°ÝÃD, ½Ð°Ý¦³«e½ú¥i¥HÀ°¦£«üÂI¶Ü?

¤U¸ü (27.69 KB)

2020-12-14 02:26

1. For l = Range("A65536").End(xlUp).Row To 2 Step -1
   
2.         If .Cells(l, "I") = .Cells(l - 1, "I") And .Cells(l, "J") = .Cells(l - 1, "J") Then
   
3.             .Cells(l - 1, "M") = .Cells(l, "L") + .Cells(l - 1, "L")
   
4.             Rows(l).ClearContents
   
5.         End If
   
6.     Next
   
7. 
   
8.     Cells.Select
   
9. 
   
10.     Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, _
    
11.                       Header:=xlYes
    

½Æ»s¥N½X

½d¨Ò.rar (13.09 KB)

¤U¸ü¦¸¼Æ: 16

2020-12-14 02:29

Andy2483

¦^´_ 1# v03586


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,ÁÂÁ¦U¦ì«e½ú,ÁÂÁ½׾Â
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ßªº¸Ñ¨M¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (118.43 KB)

2023-3-24 15:07

°õ¦æµ²ªG:

¤U¸ü (82.72 KB)

2023-3-24 15:08

Option Explicit
Sub TEST_2()
Dim Brr, Y, T$, C%, j%, i&, xA As Range
'¡ô«Å§iÅܼÆ:(Brr,Y)¬O³q¥Î«¬ÅܼÆ,T¬O¦r¦êÅܼÆ,
'(C,j)¬Oµu¾ã¼Æ,i¬Oªø¾ã¼Æ,xA¬OÀx¦s®æÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Set xA = Range([M1], Cells(Rows.Count, 1).End(3)): Brr = xA
'¡ô¥OxA³oÀx¦s®æÅܼƬO [M1]ÂX®i¨ìAÄæ³Ì«á¦³¤º®eÀx¦s®æ
'¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥HxAÅܼÆ(Àx¦s®æ­È)±a¤J
C = UBound(Brr, 2)
'¡ô¥OC³oµu¾ã¼ÆÅܼƬO Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q2¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   T = Brr(i, 9) & "|" & Brr(i, 10)
   '¡ô¥OT³o¦r¦êÅܼƬO i°j°é¦C²Ä9ÄæBrr°}¦C­È ³s±µ "|",
   '¦A³s±µ i°j°é¦C²Ä10ÄæBrr°}¦C­È,©Ò²Õ¦¨ªº·s¦r¦ê
   If Y(T) = "" Then
   '¡ô¦pªGTÅܼƬdY¦r¨åªºitem­È¬OªÅ¦r¤¸?
   '(³o°Ý¥y¤w¸g±N TÅܼƷíkey,item¬OªÅ¦r¤¸,¯Ç¤JY¦r¨å¤F,¤w¼W¥[­Ó·skey)
      Y(T) = Y.Count + 1
      '¡ô¥O TÅܼƷíkey,item¬O Y¦r¨åkey¼Æ¶q + 1
      For j = 1 To C - 1: Brr(Y(T), j) = Brr(i, j): Next
      '¡ô³]¶¶°j°é!j±q1¨ì CÅܼÆ-1,³°Äò±N¸Ó¦C¦UÄæ­È±a¤J«ü©w¦C¦PÄæ¦ì¸m
      Brr(Y(T), 13) = Brr(Y(T), 12): GoTo i01
      '¡ô¥O(TÅܼƬdY¦r¨åitem­È)¦C²Ä13ÄæBrr°}¦C­È¬O
      '(TÅܼƬdY¦r¨åitem­È)¦C²Ä12ÄæBrr°}¦C­È
      '¥Oµ{§Ç¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   End If
   Brr(Y(T), 13) = Brr(Y(T), 13) + Brr(i, 12)
   '¡ô¥O(TÅܼƬdY¦r¨åitem­È)¦C²Ä13ÄæBrr°}¦C­È¬O
   '¦Û¨­­È + (TÅܼƬdY¦r¨åitem­È)¦C²Ä12ÄæBrr°}¦C­È
i01: Next
ActiveSheet.UsedRange.Clear
'¡ô¥O¦³¨Ï¥ÎÀx¦s®æ½d³ò°µ²M°£
xA.Resize(Y.Count + 1, C) = Brr
'¡ô¥OxAÅܼÆ(Àx¦s®æ)²Ä1®æÂX®i¦V¤U Y¦r¨åkey¼Æ¶q+1¦C,
'¦V¥kÂX®iCÅܼÆÄæ,³o½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J
Set Y = Nothing: Set xA = Nothing: Erase Brr
'ÄÀ©ñÅܼÆ
End Sub

n7822123

¦^´_ 10# v03586

§A·|¥Î¦r¨åª«¥óªº¸Ü¡A¾ÇSamwangªº¼gªk´N¥i¥H¤F

hcm19522¤j¤j¡A¤]ÃÒ©ú¤F¨ç¼Æ¥i¥H¸Ñ¨M99.99% ªº°ÝÃD

§Úªº¼gªk¥²¶·­n¥ý¸g¹L±Æ¦C¡A¤£µM·|¦³°ÝÃD~~

¦^ÀY¬Ý§Ú¼gªºªF¦è¡A¼gªº¦³ÂI²ÖÂØ~~~²¤Â²¤Æ¦p¤U~

Sub ¥[Á`()
Dim Arr, PKey$, §R°£¦C As Range
Arr = [A1].CurrentRegion    '§ìÀx¦s®æ¸ê®Æ ¨ì Arr °}¦C
Set §R°£¦C = Rows(UBound(Arr) + 1)  '³o¦æ³æ¯Â¥u¬OÁקKUnion¸õ¥X¿ù»~¡A¥ý©w­Ó½d³ò
For R& = 2 To UBound(Arr)  '¤£¦PªºKey¬ö¿ýÀY¤@­Ó¦C¸¹¡A¬Û¦PKey°µ²Ö¥[¡A°O¿ý¤§«á­n§R°£ªº¦C¸¹
  Key$ = Arr(R, 9) & Arr(R, 10)
  If Key <> PKey Then
    R0& = R: PKey = Key
    Arr(R, 13) = Arr(R, 12)
  Else
    Arr(R0, 13) = Arr(R0, 13) + Arr(R, 12)
     Set §R°£¦C = Union(§R°£¦C, Rows(R))
  End If
Next R
[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr  'Arr¸ê®Æ­Ë¦^¥hÀx¦s®æ
§R°£¦C.Delete   '¥i§ï¬° §R°£¦C.Select ½T»{§R°£½d³ò
End Sub

v03586

¦^´_ 9# samwang


    ·PÁ«e½úªº«ü¾É, ¨âºØ¤è¦¡³£¦³¾Ç°_¨Ó!! ¥H«á¦³°ÝÃD¦A½Ð«e½ú¦h¦h«ü±Ð!!

v03586

¦^´_ 5# n7822123


    ·PÁ«e½ú­Ìªº´£¿ô, ¯uªº°}¦C¶]§Ö«D±`¦h, ¨D¾Ç®É´Á°}¦C¯uªº§â§Ú·dºG¤F, ¥XªÀ·|«á¤~µo²{¯u¥¿¹ê¥Îªº¦a¤è!!

samwang

¦^´_ 1# v03586

§ó·sµ{¦¡½X¦p¤U¡AÁÂÁÂ

Sub TEST_2()
Dim Arr, xD, T, N%, j%, NR
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([M1], [A65536].End(3))
For i = 1 To UBound(Arr)
    T = Arr(i, 9) & Arr(i, 10)
    If xD.Exists(T & "") Then
        NR = xD(T & "")
        Arr(NR, 13) = Arr(NR, 13) + Arr(i, 12)
    Else
        N = N + 1
        xD(T & "") = N
        For j = 1 To 12: Arr(N, j) = Arr(i, j): Next
        Arr(N, 13) = Arr(N, 12)
  End If
Next
Range("A1:M" & [A65536].End(3).Row) = ""
Arr(1, 13) = "TIME"
[A1].Resize(N, 13) = Arr
End Sub

samwang

¦^´_ 7# n7822123


·PÁ«ü¾É¡A¯uªº«Ü²Ê¤ß¤j·N¡A·P®¦¡C

n7822123

¦^´_ 6# samwang

¬Oªü¡A§Aªºµ{¦¡ºâ¥X¨Óªº­È~ ¨S²Ö¥[¨ìÀY¤@¦C~

¥u±q²Ä2¦C©¹¤U²Ö¥[~

¤U¸ü (10.68 KB)

2020-12-14 15:36

samwang

¦^´_ 4# n7822123

§A§Ñ°O²Ö¥[ÀY¤@¦C¤F³á~

    If xD.Exists(T & "") Then
         NR = xD(T & "")
         Arr(NR, 13) = Arr(NR, 13) + Arr(i, 12)
     Else
         N = N + 1
         xD(T & "") = N
         For j = 1 To 12: Arr(N, j) = Arr(i, j): Next
         Arr(N, 13) = Arr(N, 12)
    End If

½Ð°Ýn7822123 ±z´£°ÝÃD  §Ñ°O²Ö¥[ÀY¤@¦C¤F³á~  ¡A¬O­ì¥»§Ú¦^ÂЪº¨º¤@¦C¶Ü?
·PÁ«ü±Ð¡C

Range("A1:M" & [A65536].End(3).Row) = ""
Arr(1, 13) = "TIME"
[A1].Resize(N, 13) = Arr
End Sub

n7822123

¦^´_ 1# v03586

§Ú´£¨Ñ¤@­Ó¤ñ¸û "ª½Ä±" ¥B ¤£¥Î¦r¨åª«¥óªº¼gªkµ¹§A

Arr°}¦C¥u¬O¬°¤F¥[§Ö¹Bºâ³t«× (¥Î Cellª«¥ó ¹Bºâ·|¸ûºC)

­Y¬Ý¤£À´¡A¥u­n§âArr §ï¦¨ Cell §A´NÀ´¤F Ex: Arr(R,12) => Cell(R,12)

µ{¦¡¦p¤U


Sub ¥[Á`()
Dim Arr, R_Del_Arr, PKey$, §R°£¦C As Range
Arr = [A1].CurrentRegion    '§ìÀx¦s®æ¸ê®Æ ¨ì Arr °}¦C
'¤£¦PªºKey¬ö¿ýÀY¤@­Ó¦C¸¹¡A¬Û¦PKey°µ²Ö¥[¡A°O¿ý¤§«á­n§R°£ªº¦C¸¹
For R& = 2 To UBound(Arr)
  Key$ = Arr(R, 9) & Arr(R, 10)
  If Key <> PKey Then
    R0& = R: PKey = Key
    Arr(R, 13) = Arr(R, 12)
  Else
    Arr(R0, 13) = Arr(R0, 13) + Arr(R, 12)
    R_Del$ = R_Del$ & "," & R
  End If
Next R
R_Del_Arr = Split(Mid(R_Del, 2), ",")
[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr  'Arr¸ê®Æ­Ë¦^¥hÀx¦s®æ
'§R°£­«½Æ¦C
For Each Rd In R_Del_Arr
  If §R°£¦C Is Nothing Then
    Set §R°£¦C = Rows(Rd)
  Else
    Set §R°£¦C = Union(§R°£¦C, Rows(Rd))
  End If
Next
§R°£¦C.Delete   '¥i§ï¬° §R°£¦C.Select ½T»{§R°£½d³ò
End Sub