¦r¨å¨Ì±ø¥ó­pºâ¦U¤ëª÷ÃB»P¼Æ¶q

shuo1125

¦U¦ì«e½ú¦n!
½Ð°Ý·Q±q¸ê®Æªí¤¤­pºâ¦U¤ë¤ä¥IÁ`ÃB¤Î¼Æ¶q¿é¥X©ó²Î­pªí¤¤¡A
³o­Ó­Y­n¥Î¦r¨å¤è¦¡¨Ó¦p¦ó°µ..?
¦pªþÀÉ¡A·Ð½Ð°ª¤âÀ°¦£¸Ñµª¡A
ÁÂÁ¤j®a!!

Andy2483

¦^´_ 11# shuo1125


    ¤µ¤Ñ¬ã¨s¼ÐÃDÄæ¨Ï¥Î¤d¤À¦ì³r¸¹ªº¤èªk,½Ð«e½ú°Ñ¦Ò

°õ¦æµ²ªG:

¤U¸ü (138.86 KB)

2023-6-9 10:27

'Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1)
Crr(R, 1) = Application.Text(A(i) + 1, "#,##0_ ") & "~" & vbLf & Application.Text(A(i + 1), "#,##0_ ")

Andy2483

¦^´_ 11# shuo1125


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P«á¾Ç¤@°_¾Ç²ß,ÁÂÁ¦U¦ì«e½ú,ÁÂÁ½׾Â
«á¾Ç¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð


Option Explicit
Sub TEST_1() '¡ô
Dim Brr, Crr(1 To 100, 1 To 100), Z, A, B$, i&, R&, C%, Y&, X%, T$, K%, S%, N&, M, Q
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary"): C = 1: R = 1
'¡ô¥OZÅܼƬO ¦r¨å,¥OC»PRªº°_©l­È¬O 1
A = Array(0, 5000, 10000, 50000, 100000, 500000, 10 ^ 6, 5000000, 10 ^ 7, 10 ^ 10)
'¡ô¥OAÅܼƬO ¤@ºû°}¦C,§G¤J·Q­nªºª÷ÃB¯Å¶Z
K = UBound(A): S = K + 3
'¡ô¥OKÅܼƬOA°}¦C³Ì¤j¯Á¤Þ¸¹,(PS:A°}¦Cªº³Ì¤p¯Á¤Þ¸¹¬O 0)
For i = 0 To K - 1
   R = R + 1
   Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1): Crr(R + S, 1) = Crr(R, 1)
   Z(A(i + 1) & "$") = R: Z(A(i + 1) & "N") = R + S
Next
'¡ô³]¶¶°j°é±N¼ÐÃDÄæ¼g¤JCrr°}¦C¤¤,¨Ã¥OZ¦r¨å°O¦í¯Å¶Z©Ò¦bªºCrr°}¦C¦C¸¹
Brr = Range([¸ê®Æ!D2], [¸ê®Æ!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥H¸ê®ÆªíA~DÄæÀx¦s®æ­È±a¤J°}¦C¤¤
Sheets("²Î­p").UsedRange.Clear
'¡ô¥O²Î­pªí¦³¨Ï¥ÎªºÀx¦s®æ²M°£
With Sheets("²Î­p").[A1:D4].Resize(UBound(Brr))
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1: Brr = .Value
   '¡ô¥OBrr°}¦C­È¥ý¼g¤J¦b²Î­pªí¤¤¥ý°µ¥H²Ä1Ä欰°ò·Çªº¶¶±Æ§Ç
   For i = 1 To UBound(Brr)
      T = Brr(i, 1)
      If Z(T & "y") = "" Then
         C = C + 1: Crr(1, C) = T: Z(T & "y") = C: Crr(S + 1, C) = T
      End If
   Next
   '¡ô³]¶¶°j°é!¥O¼ÐÃD¦C¼g¤JCrr°}¦C¤¤,¨Ã¥OZ¦r¨å°O¦í¦~¤À©Ò¦bªºÄ渹
   .Sort KEY1:=.Item(4), Order1:=1, Header:=2, Orientation:=1
   '¡ô¥O¸Ó½d³òÀx¦s®æ°µ¥H²Ä4Ä欰°ò·Çªº¶¶±Æ§Ç
   Brr = .Value: .Clear
   '¡ô¥OBrr°}¦C²±¸Ë°}¦C­È,¥O¸Ó½d³òÀx¦s®æ²M°£
End With
Crr(1, 1) = "·JÁ`-NTD": Crr(S + 1, 1) = "·JÁ`-QTY": B = "[Total]"
R = R + 1: Crr(R, 1) = B: Crr(R + S, 1) = B
C = C + 1: Crr(1, C) = B: Crr(S + 1, C) = B
'¡ô¥O¥D¼ÐÃD»PÁ`©M¼ÐÃD¼g¤JCrr°}¦C¤¤
'================================================
For i = 1 To UBound(Brr)
   Q = Val(Brr(i, 4))
   If Q > M Then N = N + 1: M = A(N)
   X = Z(Brr(i, 1) & "y"): Y = Z(M & "$")
   Crr(Y, X) = Crr(Y, X) + Q: Crr(R, X) = Crr(R, X) + Q
   Crr(Y, C) = Crr(Y, C) + Q: Crr(R, C) = Crr(R, C) + Q
   Crr(Y + S, X) = Crr(Y + S, X) + 1: Crr(R + S, X) = Crr(R + S, X) + 1
   Crr(Y + S, C) = Crr(Y + S, C) + 1: Crr(R + S, C) = Crr(R + S, C) + 1
Next
'¡ô³]¶¶°j°é±NBrr°}¦Cªºª÷ÃB±q¤p¨ì¤j¬Û¥[¦bCrr°}¦C¤¤
With [²Î­p!A1].Resize(R + S, C)
   .Columns.ColumnWidth = 14
   Intersect(.Cells, Rows("1:" & K + 2)).Borders.LineStyle = 1
   Intersect(.Cells, Rows(S + 1 & ":" & R + S)).Borders.LineStyle = 1
   Union(.Rows(1), .Rows(K + 2), .Rows(S + 1)).Font.Bold = True
   Union(.Rows(R + S), .Columns(C)).Font.Bold = True
   Range([B2], .Cells(K + 2, C)).NumberFormatLocal = "#,##0_ "
   Range(.Cells(S + 2, 2), .Cells(R + S, C)).NumberFormatLocal = "#,##0_ "
   .Value = Crr
End With
'¡ô³B²z²Î­pªí¥²­nÀx¦s®æ®æ¦¡,³Ì«á¶ñ¤JCrr°}¦C­È
Set Z = Nothing: Erase Brr, Crr, A
'¡ôÄÀ©ñÅܼÆ
End Sub

shuo1125

¦^´_ 10# Andy2483
Andy«e½ú¯uªº¼F®`....ÁÙ±N»Ý¨DÂX¥R©µ¦ù¡A
ªp¥B³o«ä¸ô¸ò®Ä²v¯uªºÅå¤H!!
·P¿E!

Andy2483

¦^´_ 1# shuo1125


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

°õ¦æµ²ªG:

¤U¸ü (167.89 KB)

2023-6-8 11:49

Option Explicit
Sub TEST_1() '¡ô
Dim Brr, Crr(1 To 100, 1 To 100), Z, A, B$, i&, R&, C%, Y&, X%, T$, K%, S%, N&, M, Q
Set Z = CreateObject("Scripting.Dictionary"): C = 1: R = 1
A = Array(0, 5000, 10000, 50000, 100000, 500000, 10 ^ 6, 5000000, 10 ^ 7, 10 ^ 10)
K = UBound(A): S = K + 3
For i = 0 To K - 1
   R = R + 1
   Crr(R, 1) = A(i) + 1 & "~" & vbLf & A(i + 1): Crr(R + S, 1) = Crr(R, 1)
   Z(A(i + 1) & "$") = R: Z(A(i + 1) & "N") = R + S
Next
Brr = Range([¸ê®Æ!D2], [¸ê®Æ!A65536].End(3))
Sheets("²Î­p").UsedRange.Clear
With Sheets("²Î­p").[A1:D4].Resize(UBound(Brr))
   .Value = Brr
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2, Orientation:=1: Brr = .Value
   For i = 1 To UBound(Brr)
      T = Brr(i, 1)
      If Z(T & "y") = "" Then
         C = C + 1: Crr(1, C) = T: Z(T & "y") = C: Crr(S + 1, C) = T
      End If
   Next
   .Sort KEY1:=.Item(4), Order1:=1, Header:=2, Orientation:=1
   Brr = .Value: .Clear
End With
Crr(1, 1) = "·JÁ`-NTD": Crr(S + 1, 1) = "·JÁ`-QTY": B = "[Total]"
R = R + 1: Crr(R, 1) = B: Crr(R + S, 1) = B
C = C + 1: Crr(1, C) = B: Crr(S + 1, C) = B
'=========================================
For i = 1 To UBound(Brr)
   Q = Val(Brr(i, 4))
   If Q > M Then N = N + 1: M = A(N)
   X = Z(Brr(i, 1) & "y"): Y = Z(M & "$")
   Crr(Y, X) = Crr(Y, X) + Q: Crr(R, X) = Crr(R, X) + Q
   Crr(Y, C) = Crr(Y, C) + Q: Crr(R, C) = Crr(R, C) + Q
   Crr(Y + S, X) = Crr(Y + S, X) + 1: Crr(R + S, X) = Crr(R + S, X) + 1
   Crr(Y + S, C) = Crr(Y + S, C) + 1: Crr(R + S, C) = Crr(R + S, C) + 1
Next
With [²Î­p!A1].Resize(R + S, C)
   .Columns.ColumnWidth = 14
   Intersect(.Cells, Rows("1:" & K + 2)).Borders.LineStyle = 1
   Intersect(.Cells, Rows(S + 1 & ":" & R + S)).Borders.LineStyle = 1
   Union(.Rows(1), .Rows(K + 2), .Rows(S + 1)).Font.Bold = True
   Union(.Rows(R + S), .Columns(C)).Font.Bold = True
   Range([B2], .Cells(K + 2, C)).NumberFormatLocal = "#,##0_ "
   Range(.Cells(S + 2, 2), .Cells(R + S, C)).NumberFormatLocal = "#,##0_ "
   .Value = Crr
End With
Set Z = Nothing: Erase Brr, Crr, A
End Sub

Andy2483

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


    ÁÂÁ«e½ú«ü¾É

Z = Switch(V > 10000, "10000¥H¤W", V > 5000, "5001~10000", V = V, 5000¥H¤U")
1.10000¥H¤Wªºµ§¼Æ¸û5000¥H¤Uªºµ§¼Æ¦h
2.¤j¨ì¤p§PÂ_·|¦ÛµM²£¥ÍÅÞ¿è°Ï¶¡¬OSwitch()ªº­«­nÆ[©À

shuo1125

¦^´_ 7# ­ã´£³¡ªL
­ã¤j¦n!
·Q½Ð°Ý­Y­n¦Û°ÊÂX¥R¦~¤ë¤Î¦X­p...³o¦³¿ìªk³B²z¶Ü?
§Ú¦³´¿¸g¬Ý¹L§A¼gÃþ¦üªº...¦ý§Ú¹ê¦b¤£ª¾¹D«ç½Õ¾A...
(Xl0000789)±zªº³o¥÷¬O¥H«È¤á¨Ó°µ²Î­p¤ÀÃþ»P§Ú³o°ÝÃD¦³ÂI¤£¤Ó¤@¼Ë¡A
ÁÂÁ§A¤F!!

­ã´£³¡ªL

Z = Switch(V > 10000, "10000¥H¤W", V > 5000, "5001~10000", V = V, 5000¥H¤U")

Andy2483

¦^´_ 5# shuo1125

ÁÂÁ«e½ú¦^´_
«á¾Ç¦AÀ˵ø¨Ã°µ¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, V&, Y, Z, i&, j%, T$, xR As Range
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO ¦r¨å
Brr = Range([¸ê®Æ!D2], [¸ê®Æ!A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥H¸ê®ÆªíA~DÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!±N¦U²Õ¦Xkey©w¸q¨äitem­È¯Ç¤JY¦r¨å¤¤
   T = Brr(i, 1): V = Brr(i, 4)
   '¡ô¥O°}¦C­È¥HÅܼƲ±¸Ë
   Z = Switch(V <= 5000, "5000¥H¤U", (V > 5000) * (V <= 10000), "5001~10000", V > 10000, "10000¥H¤W")
   '¡ô¥OZÅܼÆ=Switch(±ø¥ó1,­È1,±ø¥ó2,­È2,±ø¥ó3,­È3)
   Y(T & "|" & Z) = Y(T & "|" & Z) + V: Y(T & "|" & Z & "|Qty") = Y(T & "|" & Z & "|Qty") + 1
   '¡ô¥O²Õ¦X¦r¦ê·íkey,item¬O°}¦C­È²Ö¥['¡ô¥O²Õ¦X¦r¦ê·íkey,item¬OÃþ§O­Ó¼Æ²Ö¥[
Next
'=========================================
[²Î­p!B2:G4,²Î­p!B8:G10].ClearContents
'¡ô¥O²Î­pªí¸ê®Æ²M°£
Set xR = [²Î­p!A1:G4]: Brr = xR
'¡ô¥OxRÅܼƬO Àx¦s®æ,¥OBrr´«¸ËxR(·sÀx¦s®æ­È)
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1)): Next
   '¡ô³]¶¶°j°é!¥O°j°é°}¦C­È¬O(¥H¼ÐÃD¦C³s±µ"|",¦A³s±µ¼ÐÃDÄ檺²Õ¦X¦r¦ê¬dY¦r¨å±oitem­È)
Next
xR = Brr
'¡ô¥OÀx¦s®æ­È¬OBrr°}¦C­È
'=========================================
Set xR = [²Î­p!A7:G10]: Brr = xR
'¡ô¥OxRÅܼƬO Àx¦s®æ,¥OBrr´«¸ËxR(·sÀx¦s®æ­È)
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!
   For j = 2 To UBound(Brr, 2): Brr(i, j) = Y(Brr(1, j) & "|" & Brr(i, 1) & "|Qty"): Next
   '¡ô³]¶¶°j°é!
   '¥O°j°é°}¦C­È¬O(¥H¼ÐÃD¦C³s±µ"|",¦A³s±µ¼ÐÃDÄæ,³Ì«á³s±µ"|Qty"ªº²Õ¦X¦r¦ê¬dY¦r¨å±oitem­È)
Next
xR = Brr
'¡ô¥OÀx¦s®æ­È¬OBrr°}¦C­È
Set Y = Nothing: Set xR = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub

shuo1125

¦^´_ 2# Andy2483
·PÁÂAndy¤jÁ`¬O§Ö³tªº¸Ñµª....