PJChen

回復 20# 准提部林
Dear 准大,

不好意思,我沒有表達明白,F欄遇空格時,表示這段程式就結束了,
空白後的是另一份文件,所以會有不同的程式接續..

所以我想讓F欄遇空格時,停止Range("JQ4:JQ" & xRow).value的動作
請問語法該怎麼表達?
xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
Range("JQ4:JQ" & xRow).value = "=AH4-BR4"

PJChen

回復 20# 准提部林

准大,
考慮到表格的特性,我想改變一個作法,如圖
以B欄料號為依據,C欄是箱數、D欄是瓶數
找C欄的"箱數"字樣,在下一格空白處,則以B欄為列數準則,Key入公式：=INT(F4/E4)
找D欄字樣"瓶數"在下一格空白處,以B欄為列數為準則,Key入公式：=MOD(F4,E4)
當B欄料號為空白時,則"箱數" & "瓶數"的公式就結束,
否則繼續找下一個"箱數"、"瓶數"繼續Key入公式,
一直到C、D欄全部的"箱數"、"瓶數"都歷遍為止

下載 (45.79 KB)

2020-2-14 23:27

准提部林

回復 22# PJChen


上傳檔案好做事~~

PJChen

回復 23# 准提部林
表單是實際的使用格式
~~~感謝准大~~~

理貨單.rar (109.92 KB)

下載次數: 10

2020-2-15 21:45

准提部林

兩種方案, 自行選用:
Sub TEST_1()
Dim R&, Arr, Brr, i&, S&(1 To 2), V1, V2
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: GoTo 101
    If Arr(i, 1) = "合計" Then
       Brr(i, 1) = S(1) '箱數合計
       Brr(i, 2) = S(2) '瓶數合計
       Erase S: GoTo 101
    End If
    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) '瓶數累計
101: Next i
Range("M2:N" & R) = Brr
End Sub

'============================================
Sub TEST_2()
Dim R&
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
With Range("M3:N" & R)
     .Formula = "=IF($K3=$K$2,M$2,IF($K3=""合計"",SUM(M$1:M2)-SUMIF($K$1:$K2,""合計"",M$1:M2)*2," & _
            "IF(($L3="""")+($P3=0),"""",IF(M$2=""箱數"",INT($Q3/$P3),MOD($Q3,$P3)))))"
     .Value = .Value
End With


'=============================================
End Sub

PJChen

回復 25# 准提部林
請問准大,

我有另一格式的表格,同樣做法,本想套用同一程式,小小修改欄位即可,但卻無法使用,
請幫忙看下,是否還有需修改的地方?

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

複製代碼

理貨單_另一格式.rar (91.42 KB)

下載次數: 3

2020-2-16 18:43

PJChen

回復 25# 准提部林
Dear 准大,
測試了整晚,發現問題點並且解決了,可以忽略我的上個回覆~~
我的表單會因為客戶因素而有變化,第一個程式可以比較活用,我比較喜歡
您的功力真是無敵！！
TEST_2雖然很精簡,但在測試時發現,表單有變,貼上的資料會出錯

PJChen

回復 25# 准提部林
准大,

今天在作業中發現,自動計算箱瓶後,它會把表格外的某些文字清除掉,
我希望表格外的任何儲存格,都可以維持原來的樣子,這個部份能否克服?

下載 (93.9 KB)

2020-2-17 23:56

理貨單.rar (86.32 KB)

下載次數: 3

2020-2-18 00:02

准提部林

回復 28# PJChen

Sub TEST_1()
Dim R&, Arr, Brr, i&, S&(1 To 2), 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) '瓶數合計
       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) '瓶數累計
    End If
101: Next i
Range("M2:N" & R) = Brr
End Sub

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

准提部林

回復 28# PJChen


Sub TEST_2()
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, 3): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       With Range(xH, xR(0, 4))
            .Columns(1).FormulaR1C1 = "=IF(OR(RC[-1]="""",N(RC[3])=0),"""",INT(RC[4]/RC[3]))"
            .Columns(2).FormulaR1C1 = "=IF(OR(RC[-2]="""",N(RC[2])=0),"""",MOD(RC[3],RC[2]))"
            .Value = .Value
       End With
       xR(1, 3) = "=SUM(" & Range(xH(1, 1), xR(0, 3)).Address & ")" '箱數合計公式
       xR(1, 4) = "=SUM(" & Range(xH(1, 2), xR(0, 4)).Address & ")" '瓶數合計公式
       xR(1, 7) = "=SUM(" & Range(xH(1, 5), xR(0, 7)).Address & ")" '訂購數 合計公式
       C = 0
    End If
101: Next
End Sub


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