PJChen

回復 38# 准提部林
請准大指點, 程式運作一直不正常....

1. Dim R&, xR As Range, xH As Range, C%
   
2. Workbooks("理貨單II.xlsx").Sheets("BF理貨").Activate
   
3. R = Cells(Rows.Count, "K").End(xlUp).Row
   
4. If R <= 2 Then Exit Sub
   
5. For Each xR In Range("K2:K" & R)
   
6.     If xR = "品名" Then Set xH = xR(1, 8): C = 1: GoTo 101
   
7.     If xR = "合計" Then
   
8.        If C = 0 Then GoTo 101
   
9.        With Range(xH, xR(1, 8)) 'R欄填入公式
   
10.             .Formula = "=-SUMPRODUCT(([最新庫存.xlsx]飛比!$F$4:$F$70=$L3)*([最新庫存.xlsx]飛比!$CD$3:$CV$3=$B3)*([最新庫存.xlsx]飛比!$CD$4:$CV$70))"
    
11.             .Value = .Value
    
12.             Range("R:R").Replace "0", "", 1  '*****(1,完全符合)
    
13.        End With
    
14.        C = 0
    
15.     End If
    
16. 101: Next
    
17. End Sub

複製代碼

准提部林

回復 41# PJChen


Sub 劃單_公式()
Dim Rw&, xR As Range, xH As Range, C%, Fx$
Rw = Cells(Rows.Count, "K").End(xlUp).Row
If Rw <= 2 Then Exit Sub
[R2] = "=-SUMPRODUCT(([最新庫存.xlsx]飛比!$F$4:$F$70=$L2)*([最新庫存.xlsx]飛比!$CD$3:$CV$3=$B2)*([最新庫存.xlsx]飛比!$CD$4:$CV$70))"
For Each xR In Range("K2:K" & Rw)
    If xR = "品名" Then Set xH = xR(2, 8): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       With Range(xH, xR(0, 8)) 'R欄填入公式
            .FormulaR1C1 = [R2].FormulaR1C1
            .Value = .Value
            .Replace 0, "", 1  '*****(1,完全符合)
       End With
       C = 0
    End If
101: Next
[R2] = ""
End Sub


==============================

PJChen

回復 42# 准提部林
請問准大,
可否解說 以下紅字

If Rw <= 2 Then Exit Sub
    If xR = "品名" Then Set xH = xR(2, 8): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       With Range(xH, xR(0, 8))
.Replace 0, "", 1....這裡已經把0取代為空白,為什麼還需要[R2] = ""

准提部林

回復 43# PJChen

If Rw <= 2 Then Exit Sub
__資料行數小于等2, 表示表格中沒有資料

    If xR = "品名" Then Set xH = xR(2, 8): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
__找到"品名", 標註C=1, 往下找到"合計", 才算配對成功, 亦即"品名"到"合計"之間的範圍

With Range(xH, xR(0, 8))
.Replace 0, "", 1....這裡已經把0取代為空白,為什麼還需要[R2] = ""
__這裡只取代"品名(下一格)"到"合計(上一格)"之間的範圍

PJChen

回復 44# 准提部林

准大好,
我將程式只稍作修改,套用到F欄,但每次執行程式,F2都會被清除,試了多次,依然找不到原因,不明白為什麼同一程式會有不同結果?
程式如下：

1. Sub 廠缺載入()
   
2. Dim Rw&, xR As Range, xH As Range, C%, Fx$
   
3. Workbooks("理貨單II.xlsx").Sheets("BF理貨").Activate
   
4. Rw = Cells(Rows.Count, "K").End(xlUp).Row
   
5. If Rw <= 2 Then Exit Sub
   
6. [F2] = "=IF(SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))=0,"""",IF(SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))=$Q2,""廠缺"",""缺""&SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))))"
   
7. For Each xR In Range("K2:K" & Rw)
   
8.     If xR = "品名" Then Set xH = xR(2, -4): C = 1: GoTo 101
   
9.     If xR = "合計" Then
   
10.        If C = 0 Then GoTo 101
    
11.        With Range(xH, xR(0, -4)) 'F欄填入公式
    
12.             .FormulaR1C1 = [F2].FormulaR1C1
    
13.             .Value = .Value
    
14.             .Replace 0, "", 1  '*****(1,完全符合)
    
15.        End With
    
16.        C = 0
    
17.     End If
    
18. 101: Next
    
19. [F2] = ""
    
20. End Sub

複製代碼

廠缺載入.rar (331.79 KB)

下載次數: 4

2020-4-6 23:57

准提部林

回復 45# PJChen

最後一行
[F2]="實出效期"

准提部林

回復 45# PJChen

也可以這樣:
Sub 廠缺載入()
Dim Rw&, xR As Range, xH As Range, C%, Fx$, LT$
Workbooks("理貨單II.xlsx").Sheets("BF理貨").Activate
Rw = Cells(Rows.Count, "K").End(xlUp).Row
If Rw <= 2 Then Exit Sub
LT = [F2].Value
[F2] = "=IF(SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))=0,"""",IF(SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))=$Q2,""廠缺"",""缺""&SUMPRODUCT(([最新庫存.xlsx]飛比!$BJ$3:$CB$3=$B2)*([最新庫存.xlsx]飛比!$F$4:$F$64=$L2)*([最新庫存.xlsx]飛比!$BJ$4:$CB$64))))"
For Each xR In Range("K2:K" & Rw)
    If xR = "品名" Then Set xH = xR(2, -4): C = 1: GoTo 101
    If xR = "合計" Then
       If C = 0 Then GoTo 101
       With Range(xH, xR(0, -4)) 'F欄填入公式
            .FormulaR1C1 = [F2].FormulaR1C1
            .Value = .Value
            .Replace 0, "", 1  '*****(1,完全符合)
       End With
       C = 0
    End If
101: Next
[F2].Value = LT
End Sub


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

jcchiang

回復 45# PJChen

妳是要F2欄位恢復顯示"實出效期"嗎??
如果是將程式最後[F2] = ""改為[F2] = "實出效期"

准提部林

程式碼要花些時間去理解(有空就去研究研究),
不然連這小小的問題都要再問一次~~

PJChen

回復 12# jcchiang

您好,
我把這個程式寫法應用在另一查帳表格中,並且
想加入一個新功能,讓 列5:6 & 列8 &列11:12 & 列14 的數值,能夠加入箱瓶 ,但原先的數值不要變動
請問這種語法該怎麼寫?   以原值_加入箱瓶.rar (10.12 KB)

下載次數: 4

2020-5-10 11:47

EX1: C5的原值為385
則顯示值 (=之後的數值要換行)
385=
19箱+5
瓶的字樣都不顯示,如瓶數為0,則顥示值為19箱+0

EX2: E5的原值為19
則顯示值  (=之後的數值要換行)
19=
0箱+19

註：
表格內的數值會隨著產品不同而變動
原儲存格 列5:6 & 列8 &列11:12 & 列14 的數值,載入後都已值化
箱瓶的計算,以原儲存格 列5:6 & 列8 &列11:12 & 列14 的數值,去除以C3的入數