返回列表 上一主題 發帖

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

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

擷取.PNG (15.92 KB)

擷取.PNG

TOP

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


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

TOP

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

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

TOP

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

1.JPG (175.87 KB)

1.JPG

TOP

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

TOP

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

TOP

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

TOP

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


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

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

TOP

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

TOP

回復 19# shuo1125


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

TOP

        靜思自在 : 謊言像一朵盛開的鮮花,外表美麗,生命短暫。
返回列表 上一主題