[µo°Ý] ¨D§U°}¦C°ÝÃD

K0l1CHEN6

¨D§U°}¦C°ÝÃD¡A¤p§Ì¹Á¸Õ¹L¦ýµLªk¥¿½T¤À²Õ°}¦C¥[Á`¡AÁٽШD¦U¦ì¤j¤j¨ó§U¡AÁÂÁ¡I

1. Sub test()
   
2. 
   
3.     Dim arr, i, j, k, m, n, p
   
4.         arr = [A1].CurrentRegion.Offset(1).Resize(, 9).Value
   
5.     ReDim Sum(UBound(arr, 2)), t(UBound(arr, 2))
   
6.    
   
7.    
   
8.     For i = 1 To UBound(arr, 1) - 1
   
9.    
   
10.         If arr(i, 2) <> arr(i + 1, 2) Then
    
11.         
    
12.             For j = 6 To UBound(arr, 2)
    
13.                 Sum(j) = Sum(j)
    
14.                 Debug.Print Sum(j)
    
15.             Next
    
16.         Else
    
17.             For j = 6 To UBound(arr, 2)
    
18.                 Sum(j) = Sum(j) + arr(i, j)
    
19.                 Debug.Print Sum(j)
    
20.             Next
    
21. 
    
22.         End If
    
23.         
    
24.             If arr(i + 1, 4) = "²Õ¦X§é¦©" Then
    
25.                 For j = p + 1 To i - 1
    
26.                     For k = 6 To UBound(arr, 2)
    
27.                         n = Round(-arr(i + 1, k) / Sum(k) * arr(j, k), 0)
    
28.                         arr(j, k) = arr(j, k) - n
    
29.                         t(k) = t(k) + n
    
30.                     Next
    
31.                 Next
    
32.             
    
33.                 For k = 6 To UBound(arr, 2)
    
34.                     arr(j, k) = arr(j, k) + arr(i + 1, k) + t(k)
    
35.                     Sum(k) = 0: t(k) = 0
    
36.                 Next
    
37.             
    
38.                 i = i + 1: p = i
    
39.             End If
    
40.     Next
    
41.    
    
42.     For i = 1 To UBound(arr, 1) - 1
    
43.         If arr(i, 4) <> "²Õ¦X§é¦©" Then
    
44.             m = m + 1
    
45.             For j = 1 To UBound(arr, 2)
    
46.                 arr(m, j) = arr(i, j)
    
47.             Next
    
48.         End If
    
49.     Next
    
50.    
    
51.     With [l2]
    
52.         .Resize(UBound(arr, 1), UBound(arr, 2)).ClearContents
    
53.         .Resize(m).NumberFormatLocal = "yyyymmdd"
    
54.         .Resize(m, UBound(arr, 2)) = arr
    
55.     End With
    
56.    
    
57. End Sub

½Æ»s¥N½X

°a¤ªºµ

¦^´_ 1# K0l1CHEN6
¯à§_½Ð§A¦b¤W¶Ç¤@¦¸ÀÉ®× §Ú¤U¸ü¤U¨ÓÀɮ׬OÃaªº ¤£ª¾¹D¦ìÔ£  §Ú¤]·Q½m²ß¬Ý¬Ý ÁÂÁÂ

K0l1CHEN6

¦^´_ 2# °a¤ªºµ

¤p§Ì­è­è­«·s¤U¸ü¤U¨Ó¶}±Ò¬O¥¿±`ªº¡A­«·s¤W¶ÇªþÀɬ°ZIPÀ£ÁY¡A¦A³Â·Ð¤j¤j¤F·PÁ¡I

test1.zip (14.8 KB)

¤U¸ü¦¸¼Æ: 5

2020-10-9 10:24

°a¤ªºµ

¦^´_ 3# K0l1CHEN6

½Ð°Ý ¬O³o¼ËªºÅÞ¿è¶Ü? ©ÎµÛ §A§âµ²ªG ©ñ¤W¨Ó §Ú¤£¤Ó©ú¥Õ ©êºp >"<  
²Õ¦X§é¦© ¤½¦¡ ¬O«ç»òºâ §Ú¤£©ú¥Õ


javascript:;

K0l1CHEN6

¦^´_ 4# °a¤ªºµ


¤j¤j±z¦n¡A¥H¨ç¼Æªº¤½¦¡§e²{ªº¸Ü¡A¥Î654856³o²Õ¬°¨Ò¡A
»Ý­n§â¥¼µ|³æ»ù¡B¥¼µ|Á`»ù¡BÁ`µ|ÃB©M§tµ|Á`ª÷ÃB«Ì°£"²Õ¦X§é¦©"ªºª÷ÃB¥ý¦U§O¥[Á`
¦A¥H¨C­Ó­È¥h°£¥HÁ`ª÷ÃB­pºâ¥e¤ñ

¤U¸ü (77.7 KB)

2020-10-9 13:37

K0l1CHEN6

¦^´_ 4# °a¤ªºµ


©çÁ¼g±o¤£²M·¡¡A¤p§Ì¬O·Q­n§e²{

¥ý±N²Õ§O654856ªº¥¼µ|³æ»ù¡B¥¼µ|Á`»ù¡BÁ`µ|ÃB©M§tµ|Á`ª÷ÃB«Ì°£²Õ¦X§é¦©ªºª÷ÃB¥[Á`¡A
1. ¥H¥¼µ|³æ»ù¨ºÄ欰¨Ò¡A¾ãÄæ¥[Á`ª÷ÃB¬°28762
2. ¤À§O­pºâ³æ¶µ¥e¤ñ¡A¥HF2¬°¨Ò¡A6238/28762=0.217´N¬O21.7%
3. µM«á¥Î¨ºÄ檺§é¦©ª÷ÃB-285*0.217=-61.845¡A´N¥i¥Hºâ¥X§é¦©ª÷ÃB¥e¤ñ
4. ¦A±NÁÙ¨S­pºâ§é¦©ªº6238+(-61.845)=6176.155
5. ¤À§O­pºâ¨C¶µ¦©°£§é¦©ª÷ÃB«á¡A³Ì«á¦A±N§é¦©ª÷ÃB¨º¦æ§R°£

­ã´£³¡ªL

¦^´_ 6# K0l1CHEN6

¦bExcel Home¤wµo°Ý¦n´X³q, µL¤H¦^À³,
À³¬O¨S¤HÀ´·N«ä,

¦³¼Æ¶qÄæ, ©Ò¥H"³æ»ù"¨Ì¤ñ²v¦©¬O¤£²Å¦XÅ޿誺,
°Ñ¦ÒÀÉ:
test1-1.rar (11.31 KB)

¤U¸ü¦¸¼Æ: 3

2020-10-10 11:52

K0l1CHEN6

¦^´_  K0l1CHEN6

¦bExcel Home¤wµo°Ý¦n´X³q, µL¤H¦^À³,
À³¬O¨S¤HÀ´·N«ä,

¦³¼Æ¶qÄæ, ©Ò¥H"³æ»ù"¨Ì¤ñ ...
­ã´£³¡ªL µoªí©ó 2020-10-10 11:52

´£¨Ñªº¸ê®Æ¬°¥ý«e½m²ßªºÀɮסA¬G¼Æ¦r¦³¥X¤J¡AÅý¤j¤j»~¸Ñ¯uªº¬O«D±`©êºp¡I
¦]Excel Home¸Ì¤w¸g¦³¤j¤jÀ°¤p§Ì¸Ñµª³Ì­«­nªº³¡¤À
¦ý°w¹ï¦P²Õ¤À§O­pºâªº¸Ü¡A¤p§Ìªº²z¸Ñ¬O¤£¬O´N¬O­n¦A²£¥Í¤@­Ó°}¦C¨Ó¥h³æ¿W­pºâ¡H

K0l1CHEN6

¦^´_  K0l1CHEN6

¦bExcel Home¤wµo°Ý¦n´X³q, µL¤H¦^À³,
À³¬O¨S¤HÀ´·N«ä,

¦³¼Æ¶qÄæ, ©Ò¥H"³æ»ù"¨Ì¤ñ ...
­ã´£³¡ªL µoªí©ó 2020-10-10 11:52

¤p§Ì¦¨¥\¹Á¸Õ²¤¹L²Õ¦X§é¦©°µ¥[Á`¡A¤w¸g¤ÀÂ÷¨â­Ó¼Æ²Õ
¤ñ¸û¦³¹Á¸Õ¤£¤Fªº¬O¦p¦ó±N¨â­Ó°}¦C¥h°µ¤ñ¹ï

1. Sub test1()
   
2. 
   
3.     Dim arr, brr(), t
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = [A1].CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2)), t(UBound(arr, 2))
   
7.    
   
8.     For i = 2 To UBound(arr)
   
9.         If Not d.exists(arr(i, 2)) Then
   
10.             k = k + 1
    
11.             d(arr(i, 2)) = k
    
12.             
    
13.             For j = 1 To UBound(arr, 2)
    
14.                 brr(k, j) = arr(i, j)
    
15.             Next
    
16.         Else
    
17.             r = d(arr(i, 2))
    
18.             
    
19.             For j = 6 To UBound(arr, 2)
    
20.                 If arr(i, j) < 0 Then
    
21.                 Else
    
22.                     brr(r, j) = brr(r, j) + arr(i, j)
    
23.                 End If
    
24.             Next
    
25.         End If
    
26.     Next
    
27. 
    
28.     For i = 1 To UBound(arr, 1) - 1
    
29.         If arr(i, 4) <> "²Õ¦X§é¦©" Then
    
30.             m = m + 1
    
31.             
    
32.             For j = 1 To UBound(arr, 2)
    
33.                 arr(m, j) = arr(i, j)
    
34.             Next
    
35.             
    
36.         End If
    
37.     Next
    
38.    
    
39.     With [K1]
    
40.         .Resize(UBound(arr, 1), UBound(arr, 2)).ClearContents
    
41.         .Resize(m).NumberFormatLocal = "yyyymmdd"
    
42.         .Resize(m, UBound(arr, 2)) = arr
    
43.     End With
    
44.    
    
45.     [U2].Resize(k, 9) = brr
    
46.    
    
47. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

Sub TEST_A01()
Dim Arr, xD, i&, j%, N&, T$, U&
Set xD = CreateObject("Scripting.Dictionary")
Sheets("¤u§@ªí2").UsedRange.EntireRow.Delete
Arr = Range([¤u§@ªí1!I1], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
    T = Arr(i, 2) & "|"
    If Arr(i, 4) = "²Õ¦X§é¦©" Then T = T & "S"
    For j = 6 To 9:  xD(T & j) = xD(T & j) + Arr(i, j):  Next
Next i
'-----------------------------------
For i = 2 To UBound(Arr)
    If Arr(i, 4) = "²Õ¦X§é¦©" Then GoTo i01
    T = Arr(i, 2) & "|"
    N = N + 1
    For j = 1 To 5: Arr(N + 1, j) = Arr(i, j): Next
    For j = 6 To 9
        Arr(N + 1, j) = Arr(i, j) + Arr(i, j) * (xD(T & "S" & j) / xD(T & j))
    Next j
i01: Next i
'-----------------------------------
[¤u§@ªí2!A1:I1].Resize(N + 1) = Arr
End Sub

test1-A01.rar (16.61 KB)

¤U¸ü¦¸¼Æ: 15

2020-10-10 15:42

¤p¼Æ¤£¶i¦ì, ­Y­n¶i¦ì, ¥i¯à¨ä¥[Á`«á¦³¦]¶i1©Î°h1©Ò²£¥Íªº»~®t


'=====================================