麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 兩表比對後將結果輸出 [打印本頁]

作者: shuo1125 時間: 2022-5-24 15:17 標題: 兩表比對後將結果輸出

各位前輩好，
想以字典方式比對兩表後將結果輸出，
但寫一半又卡住了...請問有人可以提供解法/思維嗎，
需求:
1.試算表A欄比對參數表HKACC及ACCTE為S，將ACC結果輸出至科餘表。
2.試算表有期末借方/貸方餘額，對應參數表ACCDN為DR則數字為正；若為CR則數字為負。
3.科餘表C欄=參數表G欄。
若不清楚請詳附檔，麻煩大家了！

作者: samwang 時間: 2022-5-24 16:24

各位前輩好，
想以字典方式比對兩表後將結果輸出，
但寫一半又卡住了...請問有人可以提供解法/思維嗎，
...
shuo1125 發表於 2022-5-24 15:17

請測試看看，謝謝
Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheet1.[A1].CurrentRegion
For i = 2 To UBound(Arr)
T = Arr(i, 3): T1 = Arr(i, 5)
If UCase(T1) = "S" Then
      xD(T) = Array(Arr(i, 4), Arr(i, 7))
End If
Next
Arr = Sheet2.[A1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
T = Arr(i, 1)
If xD.Exists(T) Then
      n = n + 1: Brr(n, 3) = xD(T)(1)
      Brr(n, 1) = T: Brr(n, 2) = Arr(i, 2)
      If UCase(xD(T)(0)) = "DR" Then
         If Arr(i, 10) > Arr(i, 11) Then
            Brr(n, 7) = Arr(i, 10)
         Else
            Brr(n, 7) = Arr(i, 11)
         End If
      ElseIf UCase(xD(T)(0)) = "CR" Then
         If Arr(i, 10) > Arr(i, 11) Then
            Brr(n, 7) = -Arr(i, 10)
         Else
            Brr(n, 7) = -Arr(i, 11)
         End If
      End If
End If
99: Next
If n > 0 Then
Sheet3.[A8].Resize(n, 7) = Brr
End If
End Sub

作者: shuo1125 時間: 2022-5-24 17:51

回復 2# samwang

謝謝s大，抽空我在做測試！
萬分感謝

作者: shuo1125 時間: 2022-5-24 21:02

回復 2# samwang
S大
測試OK，可以請問一下xD(T)(1)後面這個(1)代表的意思嗎..?
謝謝您！

作者: samwang 時間: 2022-5-24 21:20

回復 samwang
S大
測試OK，可以請問一下xD(T)(1)後面這個(1)代表的意思嗎..?
謝謝您！
shuo1125 發表於 2022-5-24 21:02

可以請問一下xD(T)(1)後面這個(1)代表的意思嗎..?
>>xD(T) = Array(Arr(i, 4), Arr(i, 7))
xD(T)(0)取出 Arr(i, 4)
xD(T)(1)取出 Arr(i, 7)

作者: shuo1125 時間: 2022-5-24 21:44

回復 5# samwang
我知道了..是取陣列資料
謝謝你詳細的回覆！

作者: shuo1125 時間: 2022-5-25 08:20

回復 5# samwang
sam大
抱歉注意看才發現有某欄抓錯...
請問這部分如何調整，
謝謝。

作者: shuo1125 時間: 2022-5-25 08:39

回復 5# samwang

sam大
抱歉在更正一下，
可能是我說明不夠清楚，是將試算表科目比對參數後，
輸出參數的ACC及ACCNE，
如圖檔說明，麻煩再幫忙看看..
謝謝。

作者: samwang 時間: 2022-5-25 11:33

回復 samwang

sam大
抱歉在更正一下，
可能是我說明不夠清楚，是將試算表科目比對參數後，
輸出參數 ...
shuo1125 發表於 2022-5-25 08:39

更新如紅字部分，請再測試看看，謝謝

Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheet1.[A1].CurrentRegion
For i = 2 To UBound(Arr)
T = Arr(i, 3): T1 = Arr(i, 5)
If UCase(T1) = "S" Then
      xD(T) = Array(Arr(i, 4), Arr(i, 7), Arr(i, 2), Arr(i, 10))
End If
Next
Arr = Sheet2.[A1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
T = Arr(i, 1)
If xD.Exists(T) Then
      n = n + 1: Brr(n, 3) = xD(T)(1)
      Brr(n, 1) = xD(T)(2): Brr(n, 2) = xD(T)(3)
      If UCase(xD(T)(0)) = "DR" Then
      ....
      ....
      ....

作者: shuo1125 時間: 2022-5-25 11:46

回復 9# samwang
sam大
感謝你如此詳細的說明，
我後來嘗試調整也跟你調的差不多...
你提供這方式對我很有幫助，
萬分感激。

作者: shuo1125 時間: 2022-5-31 09:27

回復 9# samwang
sam大
抱歉在請問，若想要增加科目去重及合併金額..
這部分要如何修改，詳如圖片，
再次麻煩了..謝謝您！

作者: samwang 時間: 2022-5-31 09:48

回復 samwang
sam大
抱歉在請問，若想要增加科目去重及合併金額..
這部分要如何修改，詳如圖片，
再次 ...
shuo1125 發表於 2022-5-31 09:27

不好意思，看不太懂您的意思，請舉例補充說明一下，謝謝

作者: shuo1125 時間: 2022-5-31 10:12

回復 12# samwang
sam大
抱歉表達不清，簡言之就是將同科目金額匯總成一筆就好...
若不清楚詳附檔，麻煩您了！

作者: samwang 時間: 2022-5-31 12:25

回復 samwang
sam大
抱歉表達不清，簡言之就是將同科目金額匯總成一筆就好...
若不清楚詳附檔，麻煩您 ...
shuo1125 發表於 2022-5-31 10:12

請再測試看看，謝謝
Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, n1%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
Arr = Sheet1.[A1].CurrentRegion
For i = 2 To UBound(Arr)
T = Arr(i, 3): T1 = Arr(i, 5)
If UCase(T1) = "S" Then
      xD(T) = Array(Arr(i, 2), Arr(i, 4), Arr(i, 7), Arr(i, 10))
End If
Next
Arr = Sheet2.[A1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
T = Arr(i, 1)
If xD.Exists(T) Then
      T1 = xD(T)(0)
      If xD1.Exists(T1) Then
         n1 = xD1(T1)
         If UCase(xD(T)(1)) = "DR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                  Brr(n1, 7) = Brr(n1, 7) + Arr(i, 10)
            Else
                  Brr(n1, 7) = Brr(n1, 7) + Arr(i, 11)
            End If
         ElseIf UCase(xD(T)(1)) = "CR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                  Brr(n1, 7) = Brr(n1, 7) - Arr(i, 10)
            Else
                  Brr(n1, 7) = Brr(n1, 7) - Arr(i, 11)
            End If
         End If
      Else
         n = n + 1: xD1(T1) = n: Brr(n, 3) = xD(T)(2)
         Brr(n, 1) = xD(T)(0): Brr(n, 2) = xD(T)(3)
         If UCase(xD(T)(1)) = "DR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                  Brr(n, 7) = Arr(i, 10)
            Else
                  Brr(n, 7) = Arr(i, 11)
            End If
         ElseIf UCase(xD(T)(1)) = "CR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                  Brr(n, 7) = -Arr(i, 10)
            Else
                  Brr(n, 7) = -Arr(i, 11)
            End If
         End If
      End If
End If
99: Next
If n > 0 Then
With Sheet3
      .[a7].CurrentRegion.Offset(5, 0) = ""
      .[A8].Resize(n, 7) = Brr
      .[G4] = Now
End With
Set xD = Nothing: Erase Arr, Brr
End If
End Sub

作者: shuo1125 時間: 2022-5-31 12:41

回復 14# samwang
sam大
測試可行，若有不解之處在勞煩你了...
感謝！

作者: samwang 時間: 2022-5-31 13:43

回復 samwang
sam大
測試可行，若有不解之處在勞煩你了...
感謝！
shuo1125 發表於 2022-5-31 12:41

更新一下如下紅字，只是讓程式縮減一下，謝謝

For i = 2 To UBound(Arr)
   T = Arr(i, 1)
   If xD.Exists(T) Then
      T1 = xD(T)(0)
      If xD1.Exists(T1) Then
         n1 = xD1(T1): m = n1
      Else
         n = n + 1: xD1(T1) = n: Brr(n, 3) = xD(T)(2)
         Brr(n, 1) = xD(T)(0): Brr(n, 2) = xD(T)(3): m = n
      End If
      If UCase(xD(T)(1)) = "DR" Then
         If Arr(i, 10) > Arr(i, 11) Then
            Brr(m, 7) = Brr(m, 7) + Arr(i, 10)
         Else
            Brr(m, 7) = Brr(m, 7) + Arr(i, 11)
         End If
      ElseIf UCase(xD(T)(1)) = "CR" Then
         If Arr(i, 10) > Arr(i, 11) Then
            Brr(m, 7) = Brr(m, 7) - Arr(i, 10)
         Else
            Brr(m, 7) = Brr(m, 7) - Arr(i, 11)
         End If
      End If

   End If
99:  Next

作者: shuo1125 時間: 2022-5-31 14:02

回復 16# samwang
sam大
太感謝了，另外我想請問一下Brr跟Brr()有什麼差別嗎...?

作者: samwang 時間: 2022-5-31 14:16

回復 samwang
sam大
太感謝了，另外我想請問一下Brr跟Brr()有什麼差別嗎...?
shuo1125 發表於 2022-5-31 14:02

不好意思，後學非本行，都只是在網站學的，理論名詞不太懂，講解不是很詳細，請見諒，謝謝

Brr: 將excel的數據資料裝入的數組
Brr(): 設定空白的數組

作者: shuo1125 時間: 2022-5-31 14:28

回復 18# samwang
sam大
那以本次為例:Brr=Brr()這樣理解應該無誤，因為皆為空白數組...
但你舉的例子及範例其實比理論還要好理解，
感謝你給予的指導，由衷感激！

作者: lpk187 時間: 2022-6-1 11:22

回復 19# shuo1125

你就是你()，不是你=你()
Brr就是Brr()

作者: shuo1125 時間: 2022-6-1 21:39

回復 20# lpk187
lpk大
這段說法太高深...
可否煩請舉個實例借喻?
謝謝！

作者: lpk187 時間: 2022-6-2 10:47

本帖最後由 lpk187 於 2022-6-2 10:50 編輯

回復 21# shuo1125

高深？不會吧！
同一個程序時
Brr()用用法是做宣告，Dim Brr() 或 Brr(2,2)...它其實就是告訴電腦，我的車比較大，可以裝比一般的變數的數量還多，因為它是陣列
而Brr是它開始載貨才用，例如 Brr=Range("A1:B5")，所以Brr和Brr()本來就是同一個，既然是同一個哪是brr=brr()，不能這樣說的，
你會跟別人說你=你嗎？還有在程式語言裡面，"=" 不是數學中的等於，而是把貨裝到這的意思！

作者: singo1232001 時間: 2022-6-2 15:45

本帖最後由 singo1232001 於 2022-6-2 16:00 編輯

回復 21# shuo1125

用魔獸世界遊戲包包的概念包包內可放任何東西    包括新的包包
dim  br 是 1格包包
redim  br(3,3 ) 是16格包包是4x4(像真實遊戲顯示那樣)
dim  br(15) 也是 16格包包  包包是一條從上到下1234567....16格

' dim  br(3) : dim ar(3) : for i = 0 to 3 : br(i)=ar  : next
br(3)(3) 也是4格包包內放入4格包包  也是4x4  16格

用檔案總管資料夾當概念資料夾內可以放任何東西  包括新資料夾
  dim br 是一個資料夾只能放一樣
  redim br(3,3) 可以放16樣 4x4(類似大圖示的瀏覽方式)
  dim br(15)  資料夾內可以讓你放16個 (類似從上到下詳細清單模式)

  一樣可以br(3)(3)

作者: shuo1125 時間: 2022-6-2 21:30

回復 22# lpk187
lpk大
大概了解了，因非相關科系所以對程式語言很陌生...
故在解讀上可能誤解，謝謝您還特意關注回復。

作者: shuo1125 時間: 2022-6-2 21:41

回復 23# singo1232001
慶大
你舉的例子陣列說明得很詳盡...
連我這一竅不通的都能大致上理解，
謝謝您抽空回復！

作者: 准提部林 時間: 2022-6-3 11:36

粗淺的說
Dim Arr, Brr(), Crr(9,9)

(1)
Arr 是Variant, 可以賦于單一元素, 或儲存格範圍成一陣列, 或Redim為一個陣列
例:Arr=9, Arr="abc", Arr=range("A1:E9"), Redim Arr(1 to 9, 1 to 3)
不管Arr已被賦于何種型態及內容, 其後仍可直接對其賦于其它型態及內容,
當用 Arr = Crr, 也是可以接收其它"己定義且存在"的陣列,

如果被定為陣列, 最後要釋放其佔用的記憶體時, 若用 Erase Arr, 則它還是陣列型態, 只是沒有大小,
當然, 它還是可以再賦于任何內容, 如 Arr = Empty (初始化)
__它是紙漿, 可以製成任何所需, 回收時變成紙漿

(2)
Brr(), 為陣列, 只是還沒定大小, 而且只能用于陣列, 就像一塊地已規劃蓋房子, 還沒定出蓋幾層及隔間, 除了房子不可挪作它用,
其間可以在任何時候重新定義其大小及維度, 如 Redim Brr(9), 每次重定義, 前身資料即消失,
若要保留前資料, 且擴展空間, 可用 ReDim Preserve , 但只可以改變最後一個維度的上標界，而不能改變維數。
可用 Erase Brr 釋放資料, 但後續要用, 得重新定義!!
__它是一張紙, 無法裝東西, 可以折成任何型狀及大小去裝東西, 恢復時還是一張紙!!!

(3)
Crr(9, 9) ,為固定大小的陣列, 這應不需說明, Erase Crr 釋放資料, 但只是清空內容, 大小還是一樣
__它是個紙箱, 可裝固定大小的東西, 倒掉全部再繼續用

作者: singo1232001 時間: 2022-6-3 18:35

本帖最後由 singo1232001 於 2022-6-3 18:41 編輯

回復 25# shuo1125

[attach]34970[/attach]

[attach]34971[/attach]

陣列貼回工作表
來源台大ptt
https://www.ptt.cc/bbs/Visual_Basic/M.1485488105.A.DB6.html

作者: shuo1125 時間: 2022-6-3 20:58

回復 26# 准提部林
准大
連准大都出現了...你給予我很大的啟發，
但你的思路及邏輯實在太變化莫測，
對我這新手來說難度真的太高...
謝謝您不吝的解說。

作者: shuo1125 時間: 2022-6-3 21:01

回復 28# shuo1125
慶大
太感謝了..還將連結告知，
這論壇不但聚集很多高手，還能毫不保留的指導，
真心感激。

作者: 准提部林 時間: 2022-6-3 21:40

'If UCase(xD(T)(1)) = "DR" Then
' If Arr(i, 10) > Arr(i, 11) Then
'       Brr(M, 7) = Brr(M, 7) + Arr(i, 10)
' Else
'       Brr(M, 7) = Brr(M, 7) + Arr(i, 11)
' End If
' ElseIf UCase(xD(T)(1)) = "CR" Then
' If Arr(i, 10) > Arr(i, 11) Then
'       Brr(M, 7) = Brr(M, 7) - Arr(i, 10)
' Else
'       Brr(M, 7) = Brr(M, 7) - Arr(i, 11)
' End If
' End If

>>>>>
If UCase(xD(T)(1)) = "DR" Then S = 1 Else S = -1
If Arr(i, 10) > Arr(i, 11) Then C = 10 Else C = 11
Brr(M, 7) = Brr(M, 7) + Arr(i, C) * S

作者: shuo1125 時間: 2022-6-4 20:33

回復 30# 准提部林
准大
還能把程式碼再縮短，
這思維跟邏輯真的學不來....
太感謝你了。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)