返回列表 上一主題 發帖

[發問] 兩表比對後將結果輸出

[發問] 兩表比對後將結果輸出

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

科餘轉換(TEXT).zip (698.12 KB)

各位前輩好,
想以字典方式比對兩表後將結果輸出,
但寫一半又卡住了...請問有人可以提供解法/思維嗎,
...
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

1.JPG (165.27 KB)

1.JPG

TOP

回復 2# samwang


    謝謝s大,抽空我在做測試!
    萬分感謝

TOP

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

TOP

回復  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)

TOP

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

TOP

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

擷取01.PNG (75.02 KB)

擷取01.PNG

TOP

回復 5# samwang

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

擷取01.PNG (84.86 KB)

擷取01.PNG

TOP

回復  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
        ....
        ....
        ....

1.JPG (186.15 KB)

1.JPG

TOP

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

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題