123
返回列表 上一主題 發帖

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

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
11# 跳轉到 »
發表於 2021-9-27 12:38 | 顯示全部帖子
回復 21# samwang

感謝您,
U & E欄的問題都解決了,
但發現另一個問題,因為每一個欄都有一個別的程式,
但只要執行了 .Value = .Value
就會干擾到其他欄位,也都變成值,
請問如何使程式之間不要互相干擾,
這樣需要保留公式的,就不會變成值！
~~~~~~~~~
另外,原來是用函數計算 派板-交板差異,請問這個有辧法開為程式嗎? 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

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
12#
發表於 2021-9-28 15:20 | 顯示全部帖子
本帖最後由 PJChen 於 2021-9-28 15:27 編輯

回復 23# samwang

您好,
轉換值的部份沒問題了！
另一個同一系列檔案,一樣指定d = xS.[Af2]

中區資料是一個全年度性的,會一直增加至年底,
H欄要統計D欄每個月最後一個日期的月統計數量
也就是同一年同一月的出貨數,第一筆不一定1日開始,最後一筆也不一定是月底日
,請問這程式要怎麼寫？
中區.rar (35.56 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
13#
發表於 2021-9-28 19:48 | 顯示全部帖子
回復 26# samwang

您好,
執行很快速,不過程式對我來說,複雜很多！能否幫我註解一下紅字用法?
另外這段程式"_",它代表什麼?
xD(Arr(i, 1) & "_" & Arr(i, 3)) = Val(xD(T)) + Val(Arr(i, 4))
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

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
14#
發表於 2021-10-4 21:37 | 顯示全部帖子
回復 28# samwang

您好,
請幫我看下程式
資料有多年度時,只有第一年計算正確,其餘合計會出錯...
中區_多年度.rar (64.59 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
15#
發表於 2021-10-5 21:11 | 顯示全部帖子
回復 30# samwang
您好,
程式更改後,仍會有錯誤,我將它篩選出來,
再麻煩幫忙看下！
感謝
中區_多年度new.rar (74.34 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
16#
發表於 2021-10-6 13:55 | 顯示全部帖子
本帖最後由 PJChen 於 2021-10-6 13:59 編輯

回復 32# samwang
謝謝，我再試試

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2021-10-6 20:06 | 顯示全部帖子
回復 32# samwang

您好,

經測試,最末一列單號空白時,無法統計數量
附上測試結果 中區_多年度.rar (74.6 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
18#
發表於 2021-10-6 22:12 | 顯示全部帖子
本帖最後由 PJChen 於 2021-10-6 22:20 編輯

回復 32# samwang

補充 資料的規則:

1) A欄每月第一筆日期,不一定1日開始
2) A欄每月最後一筆也不一定是月底日,只要是每月的最後出現的日期就進行統計
3) 要把年度也考量進去,因為資料會不斷增加,不會只有一個年度
4) C欄的單號,會有同一日期,同一單號重複數次,我想程式中應該不用加上C欄的判別,因為單號與統計無關

我將程式改為以下,可否幫我看下,這樣會有bug嗎?
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 i < UBound(Arr) Then
            If Arr(i, 1) = Arr(i + 1, 1) Then GoTo 99
        End If
        Brr(i, 1) = xD(Arr(i, 1))
99: Next
Next
Sheets("中區").[h3].Resize(UBound(Brr)) = Brr
End Sub

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
19#
發表於 2021-11-2 22:08 | 顯示全部帖子
回復 8# samwang

Sam
請問以下程式,我需要改為,符合2個條件,則整列刪除,請問要怎麼修改?
1) B欄>=[af1]
2) C欄<>"美"
整列刪除.rar (25.66 KB)
  1. Sub 刪除列2()
  2. Dim xR As Range, xU As Range
  3. For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
  4.     If IsError(Application.Match("美", xR, 0)) Then
  5.         If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
  6.     End If
  7. Next
  8. If Not xU Is Nothing Then xU.EntireRow.Delete
  9. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
20#
發表於 2021-11-3 19:53 | 顯示全部帖子
回復 39# samwang

回復 38# singo1232001

感謝二位
程式都可以執行

TOP

        靜思自在 : 不怕事多，只怕多事。
123
返回列表 上一主題