返回列表 上一主題 發帖

[發問] 求助陣列問題

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-10-8 17:54 | 顯示全部帖子

[發問] 求助陣列問題

求助陣列問題，小弟嘗試過但無法正確分組陣列加總，還請求各位大大協助，謝謝！
  1. Sub test()

  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

  22.         End If
  23.         
  24.             If arr(i + 1, 4) = "組合折扣" 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) <> "組合折扣" 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
複製代碼

2020-10-06_190331.png (121.45 KB)

2020-10-06_190331.png

test1.rar (13.87 KB)

模擬文件

收藏 分享

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
2#
發表於 2020-10-9 10:25 | 顯示全部帖子
回復 2# 軒云熊

小弟剛剛重新下載下來開啟是正常的，重新上傳附檔為ZIP壓縮，再麻煩大大了感謝！

test1.zip (14.8 KB)

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
3#
發表於 2020-10-9 13:38 | 顯示全部帖子
回復 4# 軒云熊


大大您好，以函數的公式呈現的話，用654856這組為例，
需要把未稅單價、未稅總價、總稅額和含稅總金額屏除"組合折扣"的金額先各別加總
再以每個值去除以總金額計算占比

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
4#
發表於 2020-10-10 10:25 | 顯示全部帖子
回復 4# 軒云熊


拍謝寫得不清楚，小弟是想要呈現

先將組別654856的未稅單價、未稅總價、總稅額和含稅總金額屏除組合折扣的金額加總，
1. 以未稅單價那欄為例，整欄加總金額為28762
2. 分別計算單項占比，以F2為例，6238/28762=0.217就是21.7%
3. 然後用那欄的折扣金額-285*0.217=-61.845，就可以算出折扣金額占比
4. 再將還沒計算折扣的6238+(-61.845)=6176.155
5. 分別計算每項扣除折扣金額後，最後再將折扣金額那行刪除

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
5#
發表於 2020-10-10 12:55 | 顯示全部帖子
回復  K0l1CHEN6

在Excel Home已發問好幾通, 無人回應,
應是沒人懂意思,

有數量欄, 所以"單價"依比 ...
准提部林 發表於 2020-10-10 11:52



提供的資料為先前練習的檔案，故數字有出入，讓大大誤解真的是非常抱歉！
因Excel Home裡已經有大大幫小弟解答最重要的部分
但針對同組分別計算的話，小弟的理解是不是就是要再產生一個陣列來去單獨計算？

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
6#
發表於 2020-10-10 14:18 | 顯示全部帖子
回復  K0l1CHEN6

在Excel Home已發問好幾通, 無人回應,
應是沒人懂意思,

有數量欄, 所以"單價"依比 ...
准提部林 發表於 2020-10-10 11:52





小弟成功嘗試略過組合折扣做加總，已經分離兩個數組
比較有嘗試不了的是如何將兩個陣列去做比對
  1. Sub test1()

  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

  28.     For i = 1 To UBound(arr, 1) - 1
  29.         If arr(i, 4) <> "組合折扣" 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
複製代碼

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
7#
發表於 2020-10-10 17:28 | 顯示全部帖子
回復 10# 准提部林

不愧是大大，用的程式碼比小弟精簡許多，但想要詢問一下使用"|"是因為要區隔不同欄位資料的關係嗎？

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
8#
發表於 2020-10-10 18:03 | 顯示全部帖子
回復 12# 准提部林


陣列的方法，小弟發現如果資料有空格的話不會被抓進陣列裡
所以小弟用了之前別的大大教的方式又再次修改了一下為
  1.     k = ThisWorkbook.Sheets(1).Cells.Find(What:="*", _
  2.                 After:=Range("A1"), _
  3.                 LookAt:=xlPart, _
  4.                 LookIn:=xlFormulas, _
  5.                 SearchOrder:=xlByRows, _
  6.                 SearchDirection:=xlPrevious, _
  7.                 MatchCase:=False).Row
  8.                
  9.     Arr = sh1.Range("A2:K" & k)
複製代碼

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
9#
發表於 2020-10-10 18:03 | 顯示全部帖子
回復 12# 准提部林


   感謝大大教學，非常感謝！

TOP

K0l1CHEN6

帖子
10 
主題
1 
精華
0 
積分
14 
點名
0  
作業系統
WINDOWS10 
軟體版本
office2019 
閱讀權限
10 
註冊時間
2020-8-30 
最後登錄
2023-3-3 

論壇贊助勳章
10#
發表於 2020-10-10 18:18 | 顯示全部帖子
另外想請教一下，字典和陣列的方式須要如何判定哪一個是適合自己的呢？

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題