返回列表 上一主題 發帖

[發問] 指定日期計算結餘數

本帖最後由 samwang 於 2021-9-27 08:07 編輯

回復 19# PJChen

另外一個U欄程式,紅字這一段,日期+1的寫法不能用,請問如何讓日期+1
        If Arr(i, 2) >= d And Arr(i, 4) <> "中和" Or Arr(i, 4) <> "內湖" And Arr(i, 4) <> "汐止" Then 'i=列
            .Cells(i, "u").Formula = "=B" & i & " +1 "
         ElseIf Arr(i, 2) >= d And Arr(i, 4) = "中和" Or Arr(i, 4) = "內湖" And Arr(i, 4) = "汐止" Then
             .Cells(i, "u").Formula = "=B" & i & ""
         End If

後學也是第一次用這種寫法(VBA在excel寫公式),
寫了這幾次下來好像有點規則,只要遇到變數i    " &   i   & " 然後 & 其它

TOP

回復 22# PJChen

但只要執行了 .Value = .Value
就會干擾到其他欄位,也都變成值,
>> 改為單獨欄轉為值
Range("K3:K" & R).Value = Range("K3:K" & R).Value    'K欄轉為值

TOP

回復 22# PJChen

另外,原來是用函數計算 派板-交板差異,請問這個有辧法開為程式嗎? V欄的程式也是要單獨一個哦...
V3=IF(COUNTIFS(北區!$B$2:$B3,北區!$B3,北區!$D$2:$D3,北區!$D3)=1,SUMIFS(北區!$W:$W,北區!$B:$B,北區!$B3,北區!$D:$D,北區!$D3)-SUMIFS(北區!$F:$F,北區!$B:$B,北區!$U3,北區!$D:$D,北區!$D3),0)
>> 這是要做什麼??不知道您實際需求是什麼?  

TOP

回復 25# PJChen

H欄要統計D欄每個月最後一個日期的月統計數量
>> 如下,請測試看看,謝謝
Sub test()
Dim Arr, Brr, xD, i&, T$, T1$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    If Not IsDate(Arr(i, 1)) Then GoTo 98
    T = Month(Arr(i, 1)): T1 = Month(Arr(i + 1, 1))
    If xD.Exists(T) Then
        If T <> T1 Then
            xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
        Else
            xD(T) = Val(xD(T)) + Val(Arr(i, 4))
        End If
    Else
        xD(T) = Val(Arr(i, 4))
    End If
98: Next
For Each ky In xD.keys
    For i = 1 To UBound(Arr)
        Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3))
    Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

TOP

回復 27# PJChen

能否幫我註解一下紅字用法? >>註解寫得不好、詞不達意,請見諒,謝謝

Sub test()
Dim Arr, Brr, xD, i&, T$, T1$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1) '資料裝入陣列
ReDim Brr(1 To UBound(Arr), 1 To 1) '創空的陣列用來裝答案
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    If Not IsDate(Arr(i, 1)) Then GoTo 98   '不是日期離開
    T = Month(Arr(i, 1)): T1 = Month(Arr(i + 1, 1))
    If xD.Exists(T) Then    '是否A欄月份有在字典
        If T <> T1 Then '自己與下一列日期的月份比較
            '紀錄當月最後一筆的交板數量累加,key:最後日期_採購單號,避免最後一天有多筆
            xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
        Else
            xD(T) = Val(xD(T)) + Val(Arr(i, 4)) '同月份交板數量累加
        End If
    Else
        xD(T) = Val(Arr(i, 4)) '交板數量裝入字典
    End If
98: Next
For Each ky In xD.keys  '字典keys循環
    For i = 1 To UBound(Arr)
        Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3)) '字典key:最後日期_採購單號,裝入答案陣列
    Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr  '顯示答案
End Sub

TOP

回復 29# PJChen


資料有多年度時,只有第一年計算正確,其餘合計會出錯...   
>> 更改如下,請測試看看,謝謝。
T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))

TOP

回復 31# PJChen

多餘的統計問題
>> 更新如下紅字,請再測試看看,謝謝。
For Each ky In xD.keys
    For i = 1 To UBound(Arr)
        If i < UBound(Arr) Then
            If Arr(i, 1) & "_" & Arr(i, 3) = Arr(i, 1) & "_" & Arr(i + 1, 3) Then GoTo 99
        End If
        Brr(i, 1) = xD(Arr(i, 1) & "_" & Arr(i, 3))
99: Next
Next

TOP

回復 35# PJChen

1) A欄每月第一筆日期,不一定1日開始
2) A欄每月最後一筆也不一定是月底日,只要是每月的最後出現的日期就進行統計
3) 要把年度也考量進去,因為資料會不斷增加,不會只有一個年度
4) C欄的單號,會有同一日期,同一單號重複數次,我想程式中應該不用加上C欄的判別,因為單號與統計無關
>> 您真的很用心把所有規則條件列出,35#有小問題我修改後如下,請再測試看看,謝謝
Sub test2()
Dim Arr, Brr, xD, i&, T$, T1$
Arr = Sheets("中區").Range("a3:k" & [中區!a65536].End(3).Row + 1)
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set xD = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
    If Not IsDate(Arr(i, 1)) Then GoTo 98
    T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
    If xD.Exists(T) Then
        If T <> T1 Then
            xD(Arr(i, 1)) = Val(xD(T)) + Val(Arr(i, 4))
        Else
            xD(T) = Val(xD(T)) + Val(Arr(i, 4))
        End If
    Else
        xD(T) = Val(Arr(i, 4))
    End If
98: Next
For Each ky In xD.keys
    For i = 1 To UBound(Arr)
        If Not IsDate(Arr(i, 1)) Then GoTo 99
        T = Year(Arr(i, 1)) & "|" & Month(Arr(i, 1)): T1 = Year(Arr(i, 1)) & "|" & Month(Arr(i + 1, 1))
        If T <> T1 Then Brr(i, 1) = xD(Arr(i, 1))

99: Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

TOP

回復 37# PJChen


Sub 刪除列()
Dim xR As Range, xU As Range
For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
    If xR = "美" Then GoTo 99
    If xR.Offset(, -1) < [AF1] Then GoTo 99
    Set xC = xR
    If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
99: Next
If Not xU Is Nothing Then xU.EntireRow.Delete
End Sub

TOP

回復 41# PJChen

設定區間2021/9/18(含)~2021/9/29(含)

If xR.Offset(, -1) > [AF1] And xR.Offset(, -1) < [AF2] Then GoTo 99

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題