PJChen

回復 30# 准提部林
謝謝准大,
這個程式也可以很準確的執行了^^

一樣以上支程式為模版,以下3支程式的使用時機不同,需要單獨程式使用
1        以K欄品名列數為準,ClearContents(只清除資料,不清除格式) 訂購數的數值
        要能套用到這個BF理貨工作表的每個訂購數欄位
        其他儲存格不要清除
       
2        以K欄品名列數為準
        日期以品名表頭的上一列B欄為準
        要能套用到這個BF理貨工作表的每個H,J欄位
        H欄 H3=$B1+T3-(V3+U3)-1
        J欄 J3=$B1+T3-1
       
3        以K欄品名列數為準,ClearContents H,J欄位(只清除資料,不清除格式)
        要能套用到這個BF理貨工作表的每個H,J欄位
        其他儲存格不要清除  
理貨單.rar (145.21 KB)

下載次數: 3

2020-2-18 13:42

准提部林

回復 31# PJChen


Sub 訂購數_清除()
Dim R&, xR As Range, xH As Range, C%
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
For Each xR In Range("K2:K" & R)
    If xR = "品名" Then Set xH = xR(2): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       Range(xH(1, 7), xR(0, 7)).ClearContents
       C = 0
    End If
101: Next
End Sub

Sub 允收日_公式()
Dim R&, xR As Range, xH As Range, C%, Fx$(1 To 3), j%
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
Fx(1) = "=IF(J3="""","""",J3-U3)"
Fx(2) = "=IF(J3="""","""",""~"")"
Fx(3) = "=IF(N(B$_X)*LEN(K3)*N(T3)*N(U3)=0,"""",B$_X+T3-1)"
For Each xR In Range("K2:K" & R)
    If xR = "品名" Then Set xH = xR(2, -2): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       For j = 1 To 3
           Range(xH(1, j), xR(0, -3 + j)) = Replace(Replace(Fx(j), 3, xH.Row), "_X", xH.Row - 2)
       Next j
       C = 0
    End If
101: Next
End Sub

Sub 允收日_清除()
Dim R&, xR As Range, xH As Range, C%
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
For Each xR In Range("K2:K" & R)
    If xR = "品名" Then Set xH = xR(2, -2): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       Range(xH, xR(0, 0)).ClearContents
       C = 0
    End If
101: Next
End Sub


'==================================

PJChen

回復 32# 准提部林
准大,
測試回報~~我是用同一個檔測試的,再麻煩您幫忙修改一下~~感謝
1) 公式漏掉V欄的允收±X....這個會在特殊時間用到,使用到時,會Key入數值,表頭只打在V2欄,但每個H欄的公式都要加入H3=$B$1+T3-(V3+U3)-1
2) 我想把允收的H,J欄位,key入資料後也變成值(無公式),這樣可以使檔案run快些
3) Sub 允收日_公式()....測試檔的最末2個表(表頭寫"北")無法填入允收日_公式,而且原來H,J欄位中間的~,還會被清除
請用我附上的這個檔,原先的檔,忘了在最末2個表打上日期
理貨單II.rar (146.03 KB)

下載次數: 3

2020-2-18 21:16

准提部林

回復 33# PJChen

Sub 允收日_公式()
Dim R&, xR As Range, xH As Range, C%, Fx$(1 To 3), j%
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
Fx(1) = "=IF(J3="""","""",J3-U3-V3)"
Fx(2) = "=IF(J3="""","""",""~"")"
Fx(3) = "=IF(OR(B$_X="""",K3=""""),"""",B$_X+T3-1)"
For Each xR In Range("K2:K" & R)
    If xR = "品名" Then Set xH = xR(2, -2): C = xH.Row: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       For j = 1 To 3
           Range(xH(1, j), xR(0, -3 + j)) = Replace(Replace(Fx(j), 3, C), "_X", C - 2)
       Next j
          With Range(xH, xR(0, 0)): .Value = .Value: End With
       C = 0
    End If
101: Next
End Sub


'==============================

PJChen

回復 34# 准提部林
准大,
這兩天一直在測試,發現允收日公式常常會分二段式的填入日期,執行第一次先填入J欄日期,執行第二次再填入~及H欄
合計欄有時也不加總
可以幫忙查下嗎?
附件是我用來測試的2個工作表,其中一個工作表的品名改為"產品",程式有跟著修正,2種執行過程都相同
理貨單II.rar (234.04 KB)

下載次數: 9

2020-2-20 23:03

准提部林

回復 35# PJChen

[自動計算]被關閉了(非必要不可如此設定, 可能會發生一堆問題, 例如公式無法更新計算..抓到一堆錯誤數據..):
With Range(xH, xR(0, 0)):  .Value = .Value: End With
改成:
With Range(xH, xR(0, 0)): .Calculate: .Value = .Value: End With

PJChen

回復 36# 准提部林

准大好,
程式改為With Range(xH, xR(0, 0)): .Calculate: .Value = .Value: End With 現在正常了！真謝謝你..
我在工作時,用到不少程式及公式,因為作業時間是以秒計的,不得不用手動計算,所以我才會一步步改成程式,希望可以縮短等待時間,不然有時候excel會當掉,不然就是時間太久,我會被殺了....
我看到Sub TEST_2,有訂購數的加總功能,請問Sub TEST_1可以這樣做嗎?但是加總後我想值化,不要有公式...

1. Sub TEST_1()
   
2. Dim R&, Arr, Brr, i&, S&(1 To 2), V1, V2, C%
   
3. R = Cells(Rows.Count, "K").End(xlUp).Row
   
4. If R <= 2 Then Exit Sub
   
5. Arr = Range("K2:Q" & R)
   
6. Brr = Range("M2:N" & R)
   
7. For i = 1 To UBound(Arr)
   
8.     If Arr(i, 1) = "品名" Then Erase S: C = 1: GoTo 101
   
9.     If Arr(i, 1) = "合計" Then
   
10.        Brr(i, 1) = S(1) '箱數合計
    
11.        Brr(i, 2) = S(2) '瓶數合計
    
12.        Erase S: C = 0: GoTo 101
    
13.     End If
    
14.     If C = 1 Then
    
15.        Brr(i, 1) = "":    Brr(i, 2) = ""
    
16.        V1 = Val(Arr(i, 6)) '包裝數
    
17.        V2 = Val(Arr(i, 7)) '訂購數
    
18.        If Arr(i, 2) = "" Or V1 = 0 Then GoTo 101
    
19.        Brr(i, 1) = Int(V2 / V1) '箱數
    
20.        S(1) = S(1) + Brr(i, 1)  '箱數累計
    
21.        Brr(i, 2) = V2 Mod V1  '瓶數
    
22.        S(2) = S(2) + Brr(i, 2) '瓶數累計
    
23.     End If
    
24. 101: Next i
    
25. Range("M2:N" & R) = Brr
    
26. End Sub

複製代碼

准提部林

回復 37# PJChen

Sub TEST_1()
Dim R&, Arr, Brr, i&, S&(1 To 3), V1, V2, C%
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
Arr = Range("K2:Q" & R)
Brr = Range("M2:N" & R)
For i = 1 To UBound(Arr)
    If Arr(i, 1) = "品名" Then Erase S: C = 1: GoTo 101
    If Arr(i, 1) = "合計" Then
       Brr(i, 1) = S(1) '箱數合計
       Brr(i, 2) = S(2) '瓶數合計
       Cells(i + 1, "Q") = S(3) '訂購數合計
       Erase S: C = 0: GoTo 101
    End If
    If C = 1 Then
       Brr(i, 1) = "":    Brr(i, 2) = ""
       V1 = Val(Arr(i, 6)) '包裝數
       V2 = Val(Arr(i, 7)) '訂購數
       If Arr(i, 2) = "" Or V1 = 0 Then GoTo 101
       Brr(i, 1) = Int(V2 / V1) '箱數
       S(1) = S(1) + Brr(i, 1)  '箱數累計
       Brr(i, 2) = V2 Mod V1  '瓶數
       S(2) = S(2) + Brr(i, 2) '瓶數累計
       S(3) = S(3) + V2 '訂購數累計
    End If
101: Next i
Range("M2:N" & R) = Brr
End Sub


'========================

PJChen

回復 38# 准提部林

准大好,

我想增加一個單獨程式,做為特殊訂單 增加or減少 出貨數
請教要如何依之前的程式模式修改??(一樣以品名欄的資料為依據)
1) R欄(加減數量)加入公式,之後值化
"=-SUMPRODUCT(([最新庫存.xlsx]比菲多!$F$4:$F$70=$L3)*([最新庫存.xlsx]比菲多!$CD$3:$CV$3=$B3)*([最新庫存.xlsx]比菲多!$CD$4:$CV$70))"
2) Q欄訂購數 "=Q3+R3"之後值化
理貨單II.rar (204.97 KB)

下載次數: 3

2020-3-26 22:39

PJChen

回復 38# 准提部林

准大好,

我把之前的程式拿來修改後,都無法執行,可否幫忙看下??

1. Sub 劃單_公式()
   
2. Dim R&, Fx$(1 To 2), xH As Range, C%, j%
   
3. Application.ScreenUpdating = False
   
4. Application.DisplayAlerts = False '在程序執行過程中使出現的警告框不顯示
   
5. Application.Calculation = xlManual     '手動計算
   
6. Workbooks("理貨單II.xlsx").Sheets("BF理貨").Activate
   
7. 
   
8. R = Cells(Rows.Count, "K").End(xlUp).Row
   
9. If R <= 2 Then Exit Sub
   
10. Fx(1) = "=-SUMPRODUCT(([最新庫存.xlsx]飛比!$F$4:$F$70=$L3)*([最新庫存.xlsx]飛比!$CD$3:$CV$3=$B3)*([最新庫存.xlsx]飛比!$CD$4:$CV$70))"
    
11. Fx(2) = "=Q3+R3"
    
12. For Each xR In Range("K2:K" & R)
    
13.     If xR = "品名" Then Set xH = xR(1, 8): C = xH.Row: GoTo 101
    
14.     If xR = "合計" Then
    
15.        If C = 0 Then GoTo 101
    
16.        For j = 1 To 2
    
17.        Next j
    
18.             With Range(xH, xR(0, 8)): .Calculate: .Value = .Value: End With
    
19.        C = 0
    
20.     End If
    
21. 101: Next
    
22. End Sub

複製代碼

劃單.rar (328.67 KB)

下載次數: 3

2020-3-30 19:16