Board logo

標題: [發問] 讓公式的值,直接帶入儲存格 [打印本頁]

作者: PJChen    時間: 2019-12-20 21:30     標題: 讓公式的值,直接帶入儲存格

請問大大,

我要讓JQ4計算並得到AH4-BR4的結果,但只要值(不要格式)就好,我是用以下語法,
請問有其他語法,可以直接讓AH4-BR4的值,直接帶入到JQ4一直到如同F欄的列數,
而不要像以下緩慢的步驟,因為檔案中都是公式,早上才run了一下,整個都當機了.
  1.         With Sh
  2.         Sh.Activate
  3.             Range("JQ2") = Range("H1").Value  '前一日庫存總數,貼到AH
  4.             Range("JQ4") = "=" & "AH4-BR4"
  5.             Range("JQ4").Copy
  6.             xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row  '看F欄位幾筆資料
  7.             Set Rng = Range("JQ4:JQ" & xRow)
  8.             Rng.PasteSpecial Paste:=xlPasteFormulas  '選擇性貼上公式
  9.             Application.CutCopyMode = False '使來源的copy的虛線閃動停止
  10.             Application.DisplayAlerts = False '在程序執行過程中使出現的警告框不顯示
  11.             Application.Calculation = xlAutomatic    '自動計算
  12.             Rng = Rng.Value
  13.         End With
複製代碼

作者: jcchiang    時間: 2019-12-25 08:39

回復 1# PJChen

試試看
Sub ex()
r = [F65535].End(3).Row                    'F欄位數
[JQ4].Resize(r) = "=AH4-BR4"          'JQ4以下(以F欄位數量長度)置入公式
[JQ:JQ] = [JQ:JQ].Value                      '將公式轉為數值
End Sub
作者: kim223824    時間: 2019-12-26 16:45

回復 1# PJChen

這樣試試。

With Sh

Sh.Activate
Range("JQ2") = Range("H1").Value  '前一日庫存總數,貼到AH

xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row  '看F欄位幾筆資料
Range("JQ4:JQ" & xRow).value = "=AH4-BR4"
Range("JQ4:JQ" & xRow).value  = Range("JQ4:JQ" & xRow).value   '轉換值

end With
作者: PJChen    時間: 2019-12-28 22:10

回復 2# jcchiang
回復 3# kim223824

感謝兩位的幫忙,答案都可以用

請問jcchiang
r = [F65535].End(3).Row
後面的End(3) 怎麼解讀?
它得出的答案會多3列,超出F欄列數
本來以為要改為(0),結果不能用,請問要如何做?
作者: 准提部林    時間: 2019-12-29 09:12

回復 4# PJChen


r = [F65535].End(3).Row > 是最後一筆資料的--列號

r = [F65535].End(3).Row -3 > 減去標題列上方的列數, 才是資料的--筆數


r = [F65535].End(3).Row > (3) = (xlup)
作者: 准提部林    時間: 2019-12-29 09:17

回復 1# PJChen

Range("JQ4") = "=" & "AH4-BR4"
這只是簡單公式, 並不太耗效能,
除非行數太多,
甚至已有其它大量公式[正在引用]JQ欄, 所以才會拖累速度
作者: PJChen    時間: 2019-12-29 15:18

回復 5# 准提部林
感謝准大,
r = [F65535].End(3).Row -3 資料就可以正常
關於End(3)....我想這應該各種代號有不同的用法,請問哪裡可以有這個代號解說?
作者: jcchiang    時間: 2019-12-30 11:42

回復 7# PJChen

請參考!!
https://blog.csdn.net/xuemanqianshan/article/details/89305212
向左 xlToLeft - -----1       
向右 xlToRight - ---2       
向上 xlUp - ---------3       
向下 xlDown -------4
作者: PJChen    時間: 2019-12-30 14:45

回復 8# jcchiang

謝謝
作者: PJChen    時間: 2020-1-8 22:37

回復 3# kim223824

好感謝你教的這段程式,我很常用到這個,真是實用,太感謝了...
With Sh

Sh.Activate
Range("JQ2") = Range("H1").Value  '前一日庫存總數,貼到AH

xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row  '看F欄位幾筆資料
Range("JQ4:JQ" & xRow).value = "=AH4-BR4"
Range("JQ4:JQ" & xRow).value  = Range("JQ4:JQ" & xRow).value   '轉換值

end With
作者: PJChen    時間: 2020-1-10 21:32

回復 3# kim223824

請問: 我想把類似的方法應用到以下...
W.Sheets("多")的欄數= xcol
Sheets("新")的A4 以 xcol為來源,代入公式,但執行都無作用,請問要怎麼做??
  1.    Set Sh = W.Sheets("多")
  2.         Sh.Activate
  3.         i = "A2:E2"
  4.             xcol = Sh.Range(i).Columns.Count  '看幾筆資料
  5.         With W.Sheets("新")
  6.         W.Sheets("新").Activate
  7.         Range("A4" & xcol).Value = "=" & "多!A3*多!C3" '公式
  8.        Range("A4" & xcol).Value = Range("A4" & xcol).Value
  9.         
  10.         End With   
複製代碼

作者: jcchiang    時間: 2020-1-13 13:12

回復 11# PJChen
加個"."
   Set Sh = W.Sheets("多")
        Sh.Activate
        i = "A2:E2"
            xcol = Sh.Range(i).Columns.Count  '看幾筆資料
        With W.Sheets("新")
        W.Sheets("新").Activate
       .Range("A4" & xcol).Value = "=" & "多!A3*多!C3" '公式
       .Range("A4" & xcol).Value = .Range("A4" & xcol).Value
        
        End With   
另外Range("A4" & xcol),如果xcol=5,則為Range("A45")
如果是要Range("A4")加上xcol的欄位則改為
.Range("A4").Resize(1, xcol).Value = "=" & " 多!A3*多!C3" '公式
.Range("A4").Resize(1, xcol).Value = .Range("A4").Resize(1, xcol).Value
如果xcol=5,這樣Range("A4")至Range("E4")都會放入公式,但公式的位置會變化
如果要向下放就將Resize(1,xcol)改為Resize(xcol,1)
以上提供參考
作者: PJChen    時間: 2020-1-13 21:35

回復 12# jcchiang
您好,
我把測試檔案附上,方便幫我看一下嗎?它依然不能貼上資料
以往copy資料都是以列數為準,但現在有新的需求,以EX: A:X欄為指定區間,貼資料or向右貼公式
W.Sheets("多")的欄數= xcol
Sheets("新")的A4 以 xcol為來源,代入公式,但執行都無作用,請問要怎麼做??
[attach]31637[/attach]
作者: jcchiang    時間: 2020-1-14 12:47

回復 13# PJChen
可以執行阿!!
不是有寫:Range("A4" & xcol),如果xcol=5,則為Range("A45")
以你的程式會在Sheets("新")的Range("A45")有個值
如果要向右貼公式改成這樣:
.Range("A4").Resize(1, xcol).Value = "=" & " 多!A3*多!C3" '公式
.Range("A4").Resize(1, xcol).Value = .Range("A4").Resize(1, xcol).Value
但因為公式並沒有將欄位固定,所以公式會變動
Range("A4")= "=" & " 多!A3*多!C3" '公式
Range("B4")= "=" & " 多!B3*多!D3" '公式
Range("C4")= "=" & " 多!C3*多!E3" '公式
以此類推
作者: PJChen    時間: 2020-1-14 14:49

回復 14# jcchiang

感謝再次指導,原來我把Range("A4" & xcol)理解錯誤,
這個.Range("A4").Resize(1, xcol).Value才是我要的結果
作者: PJChen    時間: 2020-1-15 20:46

回復 14# jcchiang

不好意思,我在寫公式代入時,因為公式很長,一直出現紅字,是否需要換行?我試著換行,但公式怎麼切都不行,請教這麼長的公式要怎麼換行才可以?
  1.         With W.Sheets("優")
  2.             W.Sheets("優").Activate
  3.                 Range("B15:AI19").ClearContents
  4.                     i = "B15:AI15"
  5.                         xcol = W.Sheets("優").Range(i).Columns.Count
  6.                             .Range("B15").Resize(1, xcol).Value = "=" & "VLOOKUP(B$2,飛比!$F:$FO,COUNTA(飛比!$F$3:$FO$3),)"
  7.                             .Range("B15").Resize(1, xcol).Value = .Range("B15").Resize(1, xcol).Value
  8.                             .Range("B16").Resize(1, xcol).Value = "=" & "IF(B$2="","",SUMIF(飛比!$F:$F,B$2,飛比!$FT:$FT)+1)"
  9.                             .Range("B16").Resize(1, xcol).Value = .Range("B16").Resize(1, xcol).Value
  10.                             .Range("B17").Resize(1, xcol).Value = "=" & "IF(B14-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$B$4:$B$55))>=0,"",ABS(B14-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$B$4:$B$55))))"
  11.                             .Range("B17").Resize(1, xcol).Value = .Range("B17").Resize(1, xcol).Value
  12.                             .Range("B18").Resize(1, xcol).Value = "=" & "IF(B$9*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$BJ$3:$CB$3="安")*(飛比!$BJ$4:$CB$55))>=0,"OK",INT(B$9*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$BJ$3:$CB$3="安")*(飛比!$BJ$4:$CB$55))/SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))))"
  13.                             .Range("B18").Resize(1, xcol).Value = .Range("B18").Resize(1, xcol).Value
  14.                             .Range("B19").Resize(1, xcol).Value = "=" & "IF(B$14*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$BI$4:$BI$55))>=0,"OK",INT(B$14*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$BI$4:$BI$55))/SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))))"
  15.                             .Range("B19").Resize(1, xcol).Value = .Range("B19").Resize(1, xcol).Value
  16.         End With
複製代碼

作者: 准提部林    時間: 2020-1-16 10:03

.Range("B18").Resize(1, xcol) = "=IF(B$9*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))" & _
    "-SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$BJ$3:$CB$3=""安"")*(飛比!$BJ$4:$CB$55))>=0,""OK""," & _
    "INT(B$9*SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))-SUMPRODUCT((飛比!$F$4:$F$55=B$2)" & _
    "*(飛比!$BJ$3:$CB$3=""安"")*(飛比!$BJ$4:$CB$55))/SUMPRODUCT((飛比!$F$4:$F$55=B$2)*(飛比!$G$4:$G$55))))"

字串連結用 & _
公式中有雙引號的"安", 須外加一對""安""
作者: PJChen    時間: 2020-2-8 20:49

回復 17# 准提部林

謝謝准大,
加了引號後,測試沒問題了
作者: PJChen    時間: 2020-2-13 22:15

回復 17# 准提部林
准大,
我常用到以下的功能,但工作表內的資料很多,F欄常會間隔幾列,又有其他資料接續,
這時程式就會把間隔列也都填滿
xRow = Cells(Cells.Rows.Count, "F").End(xlUp).Row  '看F欄位幾筆資料
Range("JQ4:JQ" & xRow).value = "=AH4-BR4"
Range("JQ4:JQ" & xRow).value  = Range("JQ4:JQ" & xRow).value   '轉換值
請問
要怎麼讓程式Range("JQ4:JQ" & xRow)以F欄為依據,但F欄有空格時,不要往下執行?(即 黃底欄位不要有資料)
[attach]31711[/attach]
作者: 准提部林    時間: 2020-2-14 15:22

回復 19# PJChen


Range("JQ4:JQ" & xRow).value = "=AH4-BR4"

Range("JQ4:JQ" & xRow) = "=IF(F4="""","""",AH4-BR4)"
作者: PJChen    時間: 2020-2-14 19:42

回復 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    時間: 2020-2-14 23:40

回復 20# 准提部林

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

[attach]31720[/attach]
作者: 准提部林    時間: 2020-2-15 09:48

回復 22# PJChen


上傳檔案好做事~~
作者: PJChen    時間: 2020-2-15 21:46

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

[attach]31727[/attach]
作者: 准提部林    時間: 2020-2-16 11:42

兩種方案, 自行選用:
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    時間: 2020-2-16 18:44

回復 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
複製代碼
[attach]31731[/attach]
作者: PJChen    時間: 2020-2-17 00:17

本帖最後由 PJChen 於 2020-2-17 00:18 編輯

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

本帖最後由 PJChen 於 2020-2-18 00:02 編輯

回復 25# 准提部林
准大,

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

[attach]31739[/attach]
[attach]31740[/attach]
作者: 准提部林    時間: 2020-2-18 12:04

回復 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

'================================
作者: 准提部林    時間: 2020-2-18 12:53

回復 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


'=================================
作者: PJChen    時間: 2020-2-18 13:42

回復 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欄位
        其他儲存格不要清除  
[attach]31741[/attach]
作者: 准提部林    時間: 2020-2-18 18:37

回復 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    時間: 2020-2-18 21:17

回復 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個表打上日期
[attach]31742[/attach]
作者: 准提部林    時間: 2020-2-19 12:25

回復 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    時間: 2020-2-20 23:04

回復 34# 准提部林
准大,
這兩天一直在測試,發現允收日公式常常會分二段式的填入日期,執行第一次先填入J欄日期,執行第二次再填入~及H欄
合計欄有時也不加總
可以幫忙查下嗎?
附件是我用來測試的2個工作表,其中一個工作表的品名改為"產品",程式有跟著修正,2種執行過程都相同
[attach]31746[/attach]
作者: 准提部林    時間: 2020-2-21 09:59

回復 35# PJChen

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

回復 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
複製代碼

作者: 准提部林    時間: 2020-2-22 13:20

回復 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    時間: 2020-3-26 22:41

回復 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"之後值化
[attach]31822[/attach]
作者: PJChen    時間: 2020-3-30 19:16

回復 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. R = Cells(Rows.Count, "K").End(xlUp).Row
  8. If R <= 2 Then Exit Sub
  9. Fx(1) = "=-SUMPRODUCT(([最新庫存.xlsx]飛比!$F$4:$F$70=$L3)*([最新庫存.xlsx]飛比!$CD$3:$CV$3=$B3)*([最新庫存.xlsx]飛比!$CD$4:$CV$70))"
  10. Fx(2) = "=Q3+R3"
  11. For Each xR In Range("K2:K" & R)
  12.     If xR = "品名" Then Set xH = xR(1, 8): C = xH.Row: GoTo 101
  13.     If xR = "合計" Then
  14.        If C = 0 Then GoTo 101
  15.        For j = 1 To 2
  16.        Next j
  17.             With Range(xH, xR(0, 8)): .Calculate: .Value = .Value: End With
  18.        C = 0
  19.     End If
  20. 101: Next
  21. End Sub
複製代碼
[attach]31833[/attach]
作者: PJChen    時間: 2020-4-4 18:17

回復 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
複製代碼

作者: 准提部林    時間: 2020-4-5 10:54

回復 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    時間: 2020-4-5 22:33

回復 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] = ""
作者: 准提部林    時間: 2020-4-6 12:15

回復 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    時間: 2020-4-6 23:57

回復 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
複製代碼
[attach]31896[/attach]
作者: 准提部林    時間: 2020-4-7 10:13

回復 45# PJChen

最後一行
[F2]="實出效期"
作者: 准提部林    時間: 2020-4-7 10:17

回復 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    時間: 2020-4-7 10:23

回復 45# PJChen

妳是要F2欄位恢復顯示"實出效期"嗎??
如果是將程式最後[F2] = ""改為[F2] = "實出效期"
作者: 准提部林    時間: 2020-4-7 10:58

程式碼要花些時間去理解(有空就去研究研究),
不然連這小小的問題都要再問一次~~
作者: PJChen    時間: 2020-5-10 11:47

回復 12# jcchiang

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

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的入數
作者: jcchiang    時間: 2020-5-11 10:52

回復 50# PJChen
試試看!!
Sub ex()
Dim x%, i%
Dim xR As Object
For Each xR In Range([b5], [b65535].End(3))
   If xR = "訂單" Or xR = "廠缺" Or xR = "實出數" Then
      For i = 1 To 8
         If xR.Offset(, i) <> 0 Then
            x = Application.WorksheetFunction.Quotient(xR.Offset(, i), [C3])  '計算箱數
            xR.Offset(, i) = xR.Offset(, i) & "=" & vbCrLf & x & "箱+" & xR.Offset(, i) Mod [C3]
         End If
      Next
   End If
Next
End Sub
作者: PJChen    時間: 2020-5-11 16:16

回復 51# jcchiang

您好,
請問 這個用法,為何是3列? End(3)
For Each xR In Range([b5], [b65535].End(3))
作者: jcchiang    時間: 2020-5-11 16:54

回復 52# PJChen

For Each xR In Range([b5], [b65535].End(3))
這是讓xR在Range([b5], [b65535].End(3))這個範圍內執行

If xR = "訂單" Or xR = "廠缺" Or xR = "實出數" Then
才是判斷要計算的列
作者: PJChen    時間: 2020-5-11 17:55

回復 53# jcchiang

但我不明白End(3)的用法,3有特別意思嗎?
作者: PJChen    時間: 2020-5-11 20:10

回復 53# jcchiang

真謝謝你,我知道用法了
作者: PJChen    時間: 2020-5-16 22:01

回復 53# jcchiang

大大好,
理貨單II.xlsx為來源檔,BF理貨.sheet以B欄的客戶為列數
B欄的客戶對應"客戶.sheet"歸類
歸類名稱相同的,其客戶的表格全都相同
EX:
B252:B274為林口...對應歸類為"中台"
G:P的資料,B252:B274有23列
複製G252:P274的資料
打開 "公用理貨-中台.xlsx" (歸類的檔名有含"中台")
只貼值到"2.sheet" C3 (覆蓋"公用理貨-中台.xlsx"的資料)
以上是需要執行的動作

之前我都是用類似這樣的語法
            xRow = Cells(Cells.Rows.Count, "G").End(xlUp).Row
                Range("C3:L" & xRow) = "=公式"
                Range("C3:L" & xRow).Value = Range("C3:L" & xRow).Value
1) 現在要以7個歸類名稱去找複製的活動範圍
統昶A
統昶B
中台
OK

永康
得至

2) 理貨單II.xlsx B欄的客戶,計算個數作為 複製的列數依據
請教語法要怎麼寫?
[attach]32037[/attach]
作者: PJChen    時間: 2020-5-18 19:28

回復 53# jcchiang
您好,
或者先從比較簡單的開始
EX:
B252:B274為林口

要如何指定複製列數,也就是自動計算 B:B="林口"的列數=23列
然後可以指定區間G252:P274成為複製的來源?
作者: jcchiang    時間: 2020-5-19 12:52

回復 57# PJChen
最近比較忙,沒時間研究

Sub ex()
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
For Each a In Range("B:B")
    If a = "林口" Then d(a.Address) = d(a.Address)  '抓林口的位置,廠商自行更換
Next
Range(d.Keys()(0)).Offset(, 5).Resize(d.Count, 10).Select '選擇範圍,請自行加入複製到哪的程式
End Sub
作者: PJChen    時間: 2020-5-22 20:52

回復 47# 准提部林

准大好,
理貨表格目前需要一個排序功能,目前以之前程式修改,可以排序,但無法依照我想要的功能排,
可否幫忙看下如何依以下需求作排序?  [attach]32069[/attach]

讓每個客戶表格,只要F欄有數字的,就依key1-F欄,key-2-L欄排序
數字由小到大,表格F欄空白者,就略過不排序(因有些客戶不需要此功能)

排序後,還會用到歸位的功能,另一程式就以S欄的數字做歸位動作,數字由小到大
  1. Sub 理貨排序()
  2. Dim R&, xR As Range, xH As Range, C%
  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(2): C = 1: GoTo 101
  7.     If xR = "合計" Then
  8.        If C = 0 Then GoTo 101
  9.        Set S = Range(xH(1, -4), xR(0, -4))
  10.        C = 0
  11.         .Cells.Sort Key1:=S, Key2:=.Columns("L"), Header:=xlNo    'Sorting無表頭
  12.     End If
  13. 101: Next
  14. End With
  15. End Sub
複製代碼

作者: 准提部林    時間: 2020-5-23 13:02

回復 59# PJChen

Sub 理貨排序()
Dim R&, xR As Range, xH As Range, C%, V&
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: V = 0: GoTo 101
    V = V + Val(xR(1, -4))
    If xR = "合計" Then
       If C = 0 Or V = 0 Then GoTo 101
       With Range(xH(1, -4), xR(0, 7))
           .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
                 Key2:=.Cells(1, 7), Order2:=xlAscending, Header:=xlNo
       End With
       C = 0: V = 0
    End If
101: Next
End Sub
作者: PJChen    時間: 2020-5-23 21:39

回復 60# 准提部林

請問准大,
每個表格內的排序,能夠整列排序嗎?
只有F:Q的範圍排序,表格外的資料,有些是表格內的索引,不跟著排序變動的話,整個資料會亂掉!

另外測試結果:
F320以空白格測試,排序後會在最下方,但中間會空一列,其他用空格測試時,未發現相同情形

[attach]32072[/attach]
作者: 准提部林    時間: 2020-5-24 13:29

回復 61# PJChen


Sub 理貨排序()
Dim R&, xR As Range, xH As Range, C%, V&
R = Cells(Rows.Count, "K").End(xlUp).Row
If R <= 2 Then Exit Sub
Application.ScreenUpdating = False
For Each xR In Range("K2:K" & R)
    If xR = "品名" Then Set xH = xR(2): C = 1: V = 0: GoTo 101
    V = V + Val(xR(1, -4))
    If xR = "合計" Then
       If C = 0 Or V = 0 Then GoTo 101
       Range(xH(1, -4), xR(0, -4)).Replace "", "ZZ", Lookat:=xlWhole '將空字符取代為"ZZ"
       With Range(Rows(xH.Row), Rows(xR(0).Row))
           .Sort Key1:=.Cells(1, "F"), Order1:=xlAscending, _
                 Key2:=.Cells(1, "L"), Order2:=xlAscending, Header:=xlNo
       End With
       Range(xH(1, -4), xR(0, -4)).Replace "ZZ", "", Lookat:=xlWhole  '將"ZZ取代為空
       C = 0: V = 0
    End If
101: Next
End Sub

F欄有空字符""在做怪, 導致排序問題, 用"取代"解決, 若F欄為公式, 很麻煩~~
作者: PJChen    時間: 2020-5-24 20:06

回復 62# 准提部林

准大,
測試結果已可正常執行,謝謝!
作者: PJChen    時間: 2020-5-25 23:30

回復 58# jcchiang

感謝百忙中抽空幫忙,這幾天測試程式已可運作!
作者: PJChen    時間: 2020-5-29 00:06

回復 62# 准提部林

准大好,

理貨單依需求增加小計欄位後,無法正常運作,可否幫忙看看!  [attach]32105[/attach]
需要修改以下
Sub 自動箱瓶()
1) 小計加總 箱.瓶
2) 合計加總 箱.瓶 (但不能重覆加總小計的值)

Sub 允收日公式
3) 遇小計欄位時,H & J欄 允收要空白

Sub 理貨單訂單值化
4) 也因為有了小計欄位,會把小計給覆蓋,如何讓它遇小計欄位時,不要覆蓋小計欄位?
  1. Sub 自動箱瓶()
  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
複製代碼
  1. Sub 允收日公式()
  2. Dim R&, xR As Range, xH As Range, C%, Fx$(1 To 3), j%
  3. R = Cells(Rows.Count, "K").End(xlUp).Row
  4. If R <= 2 Then Exit Sub
  5. Fx(1) = "=IF(J3="""","""",J3-U3-V3+1)" '允收(起)
  6. Fx(2) = "=IF(J3="""","""",""~"")"
  7. Fx(3) = "=IF(OR(B$_X="""",K3=""""),"""",B$_X+T3-2)" '公式(迄)
  8. For Each xR In Range("K2:K" & R)
  9.     If xR = "品名" Then Set xH = xR(2, -2): C = xH.Row: GoTo 101
  10.     If xR = "合計" Then
  11.        If C = 0 Then GoTo 101
  12.        For j = 1 To 3
  13.            Range(xH(1, j), xR(0, -3 + j)) = Replace(Replace(Fx(j), 3, C), "_X", C - 2)
  14.        Next j
  15. '          With Range(xH, xR(0, 0)): .Value = .Value: End With
  16.             With Range(xH, xR(0, 0)): .Calculate: .Value = .Value: End With
  17.        C = 0
  18.     End If
  19. 101: Next
  20. End Sub
複製代碼
  1. Sub 理貨單訂單值化()
  2. Dim Sh As Worksheet
  3.     Set Sh = Workbooks("理貨單_例外.xlsx").Sheets("鮮")
  4.             With Sh
  5.                 Sh.Activate
  6.                     .Range("貼鮮食") = "=SUMIFS(網單!$I:$I,網單!$C:$C,鮮!$C3,網單!$K:$K,鮮!$B3)+IF(鮮!$R$1=鮮!$B$1,鮮!$R3,0) 'Q欄
  7.                     .Range("貼鮮食").Value = Range("貼鮮食").Value
  8.             End With
  9. End Sub
複製代碼

作者: 准提部林    時間: 2020-5-30 13:19

回復 65# PJChen


[attach]32114[/attach]

1) 允收日怎麼算的, 自行修改
2) 理貨公式, 版本不合, 做不了
作者: PJChen    時間: 2020-5-31 22:21

回復 66# 准提部林

謝謝准大,
執行沒問題
作者: PJChen    時間: 2020-6-21 13:02

回復 51# jcchiang

您好,
原程式寫法都是從第3列開始更新公式,隨著資料持續增加,
更新時間越來越長,且函數寫成的公式很冗長,想改為非函數的寫法,
檔案每次更新後,公式便值化,除非有變動資料,否則不需要每次都從第3列開始更新公式,
所以我在"VBA".sheet的[AA3]指定一個日期,當B欄>=這個日期的資料才需要更新,
我依照這個模式,改了第一個"月份"欄,執行沒問題,但要套到以下11種不同公式的寫法,
If xR = "月份" Or xR = "採購單號碼" Or xR = "結餘" Or xR = "大" Or xR = "美"  Or xR = "大中南區" Or xR = "美中南區" Or xR = "派板對應單據日" Or xR = "派板-交板差異" Or xR = "派板結餘" Or xR = "盤點差異"
卻不知如何下手,以下是原程式, 可否幫忙看下,要如何修改?  [attach]32193[/attach]
  1. Sub 北區_公式更新()
  2. Dim Sh As Worksheet, xS As Worksheet, xR
  3. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  4. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  5. d = xS.[AA3] 'Date
  6. Sh.Activate
  7. '------------ 'A 取出B欄年.月,這段是依照您的程式修改後的
  8. For Each xR In Range([b3], [b65535].End(3)) '向上 End(3) = End(xlup).Row
  9.     If xR >= d Then
  10.         x = Year(xR) & ".." & Month(xR)
  11.         xR.Offset(, -1) = x
  12.     End If
  13. Next
  14. '------------
  15. xRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
  16. Range("E3:E" & xRow).Formula = "=IF(北區!$R3="","無交貨",北區!$T3&北區!$S3&北區!$R3)"
  17. Range("E3:E" & xRow).Value = Range("E3:E" & xRow).Value

  18. Range("K3:K" & xRow).Formula = "=K$2+SUM(G$3:G3)-SUM(F$3:F3)-SUM(H$3:I3)+SUM(J$3:J3)" '結餘
  19. Range("K3:K" & xRow).Value = Range("K3:K" & xRow).Value

  20. Range("L3:L" & xRow).Formula = "=L$2+SUMIF($C$3:$C3,L$1,$G$3:$G3)-SUMIF($C$3:$C3,L$1,$F$3:$F3)+SUM(J$3:J3)-SUM(N$3:N3)"
  21. Range("L3:L" & xRow).Value = Range("L3:L" & xRow).Value

  22. Range("M3:M" & xRow).Formula = "=M$2+SUMIF($C$3:$C3,M$1,$G$3:$G3)-SUMIF($C$3:$C3,M$1,$F$3:$F3)-SUM(O$3:O3)"
  23. Range("M3:M" & xRow).Value = Range("M3:M" & xRow).Value

  24. Range("N3:N" & xRow).Formula = "=IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=1,SUMIFS(台中!$D:$D,台中!$B:$B,"大",台中!$A:$A,北區!$B3),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=2,SUMIFS(新竹!$D:$D,新竹!$B:$B,"大",新竹!$A:$A,北區!$B4),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=3,SUMIFS(南區!$D:$D,南區!$B:$B,"大",南區!$A:$A,北區!$B5),"")))"
  25. Range("N3:N" & xRow).Value = Range("N3:N" & xRow).Value

  26. Range("O3:O" & xRow).Formula = "=IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=1,SUMIFS(台中!$D:$D,台中!$B:$B,"美",台中!$A:$A,北區!$B3),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=2,SUMIFS(新竹!$D:$D,新竹!$B:$B,"美",新竹!$A:$A,北區!$B4),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=3,SUMIFS(南區!$D:$D,南區!$B:$B,"美",南區!$A:$A,北區!$B5),"")))"
  27. Range("O3:O" & xRow).Value = Range("O3:O" & xRow).Value

  28. Range("U3:U" & xRow).Formula = "=IF(OR($D3=""中和"",$D3=""內湖"",$D3=""汐止""),$B3,$B3+1)" '派板對應單據日
  29. Range("U3:U" & xRow).Value = Range("U3:U" & xRow).Value

  30. Range("V3:V" & xRow).Formula = "=IF(COUNTIFS(B$3:B3,B3,D$3:D3,D3)=1,SUMIFS(X:X,B:B,B3,D:D,D3)-SUMIFS(F:F,B:B,V3,D:D,D3),0)" '派板-交板數差異
  31. Range("V3:V" & xRow).Value = Range("V3:V" & xRow).Value

  32. Range("X3:X" & xRow).Formula = "=Y$2+SUM($G$3:$G3)+SUM(J$3:J3)-(SUM($H$3:$H3)+SUM($I$3:$I3)+SUM($X$3:$X3))" '派板結餘
  33. Range("X3:X" & xRow).Value = Range("X3:X" & xRow).Value

  34. Range("Y3:Y" & xRow).Formula = "=盤點差異"
  35. Range("Y3:Y" & xRow).Value = Range("Y3:Y" & xRow).Value
  36. End Sub
複製代碼

作者: PJChen    時間: 2020-6-22 19:41

回復 51# jcchiang

您好,
表格上傳時有小小變動了格式,公式忘了改&有部份程式已改成我想要的執行方式,不過不知是寫法不好,或資料太多,跑得有點慢,
試過單一欄從年初資料開始更新,結果慢得像當機一樣,如果能指導下更快的寫法,就太好了!
新寫去雖然完成,但我不知如何改為陣列,所以是每欄的更新分開寫!
  1. Sub 北區_A_取年月()
  2. Dim Sh As Worksheet, xS As Worksheet, xR
  3. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  4. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  5. d = xS.[AA3] 'Date
  6. Sh.Activate
  7. '------------ 'A 取B欄年.月
  8. For Each xR In Range([b3], [b65535].End(3)) '向上 End(3) = End(xlup).Row
  9.     If xR >= d Then
  10.         xR.Offset(, -1) = Year(xR) & ".." & Month(xR)
  11.     End If
  12. Next
  13. End Sub

  14. Sub 北區_E_採購單號碼()
  15. Dim Sh As Worksheet, xS As Worksheet, xR
  16. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  17. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  18. d = xS.[AA3] 'Date
  19. Sh.Activate
  20. '------------ 'E 採購單號碼
  21. For Each xR In Range([b3], [b65535].End(3))
  22.     If xR.Offset(, 16) = "" Then 'R欄無單號
  23.     xR.Offset(, 3) = "無交貨"
  24.     End If
  25.     If xR >= d And xR.Offset(, 16) <> "" Then
  26.     xR.Offset(, 3) = xR.Offset(, 18) & xR.Offset(, 17) & xR.Offset(, 16) 'T&S&R
  27.     End If
  28. Next
  29. End Sub

  30. Sub 北區_K_結餘()
  31. Dim Sh As Worksheet, xS As Worksheet, xR
  32. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  33. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  34. d = xS.[AA3] 'Date
  35. Sh.Activate
  36. '------------ 'K 結餘
  37. For Each xR In Range([b3], [b65535].End(3))
  38.     If xR >= d Then 'k+g-f-h-i+j
  39.         xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
  40.     End If
  41. Next
  42. End Sub

  43. Sub 北區_L_大_結餘()
  44. Dim Sh As Worksheet, xS As Worksheet, xR
  45. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  46. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  47. d = xS.[AA3] 'Date
  48. Sh.Activate
  49. '------------ 'L 大,結餘
  50. For Each xR In Range([b3], [b65535].End(3))
  51.     If xR >= d And xR.Offset(, 1) = "大" Then 'l+g-f+j-n
  52.         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 5) - xR.Offset(, 4) + xR.Offset(, 8) - xR.Offset(, 12)
  53.         Else 'l+j-n
  54.         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 8) - xR.Offset(, 12)
  55.     End If
  56. Next
  57. End Sub

  58. Sub 北區_M_美_結餘()
  59. Dim Sh As Worksheet, xS As Worksheet, xR
  60. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  61. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  62. d = xS.[AA3] 'Date
  63. Sh.Activate
  64. '------------
  65. For Each xR In Range([b3], [b65535].End(3))
  66.     If xR >= d And xR.Offset(, 1) = "美" Then 'm+g-f-o
  67.         xR.Offset(, 11) = xR.Offset(-1, 11) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 13)
  68.         Else 'm-o
  69.         xR.Offset(, 11) = xR.Offset(-1, 11) - xR.Offset(, 13)
  70.     End If
  71. Next
  72. End Sub

  73. Sub 北區_U_派板對應單據日()
  74. Dim Sh As Worksheet, xS As Worksheet, xR
  75. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  76. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  77. d = xS.[AA3] 'Date
  78. Sh.Activate
  79. '------------ 'U'派板對應單據日
  80. For Each xR In Range([b3], [b65535].End(3))
  81.     If xR >= d And (xR.Offset(, 2) = "中和" Or xR.Offset(, 2) = "內湖" Or xR.Offset(, 2) = "汐止") Then
  82.         xR.Offset(, 19) = xR
  83.         Else
  84.         xR.Offset(, 19) = xR + 1
  85.     End If
  86. Next
  87. End Sub

  88. Sub 北區_X_派板結餘()
  89. Dim Sh As Worksheet, xS As Worksheet, xR
  90. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  91. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  92. d = xS.[AA3] 'Date
  93. Sh.Activate
  94. '------------ 'X'派板結餘 g+j-h-i-w
  95. For Each xR In Range([b3], [b65535].End(3))
  96.     If xR >= d Then 'x+g+j-h-i-w
  97.         xR.Offset(, 22) = xR.Offset(-1, 22) + xR.Offset(, 5) + xR.Offset(, 8) - xR.Offset(, 6) - xR.Offset(, 7) - xR.Offset(, 21)
  98.     End If
  99. Next
  100. End Sub

  101. Sub 北區_Y_盤點差異()
  102. Dim Sh As Worksheet, xS As Worksheet, xR
  103. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  104. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  105. d = xS.[AA3] 'Date
  106. Sh.Activate
  107. '------------ 'Y'盤點差異
  108. For Each xR In Range([b3], [b65535].End(3))
  109.     If xR >= d And xR.Offset(, 24) = "" Then
  110.         xR.Offset(, 23) = ""
  111.         Else 'z-x
  112.         xR.Offset(, 23) = xR.Offset(, 24) - xR.Offset(, 22)
  113.     End If
  114. Next
  115. End Sub
複製代碼
目前只剩3欄的公式,因包含了countif的函數,查了些資料,沒找到關於countif的函數如何改為VBA的寫法!
  1. Range("N3:N" & xRow).Formula = "=北區_大_中南區" '=IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=1,SUMIFS(台中!$D:$D,台中!$B:$B,"大",台中!$A:$A,北區!$B3),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=2,SUMIFS(新竹!$D:$D,新竹!$B:$B,"大",新竹!$A:$A,北區!$B4),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=3,SUMIFS(南區!$D:$D,南區!$B:$B,"大",南區!$A:$A,北區!$B5),"")))
  2. Range("N3:N" & xRow).Value = Range("N3:N" & xRow).Value

  3. Range("O3:O" & xRow).Formula = "=北區_美_中南區" '=IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=1,SUMIFS(台中!$D:$D,台中!$B:$B,"美",台中!$A:$A,北區!$B3),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=2,SUMIFS(新竹!$D:$D,新竹!$B:$B,"美",新竹!$A:$A,北區!$B4),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=3,SUMIFS(南區!$D:$D,南區!$B:$B,"美",南區!$A:$A,北區!$B5),"")))
  4. Range("O3:O" & xRow).Value = Range("O3:O" & xRow).Value

  5. Range("V3:V" & xRow).Formula = "=IF(COUNTIFS(B$3:B3,B3,D$3:D3,D3)=1,SUMIFS(W:W,B:B,B3,D:D,D3)-SUMIFS(F:F,B:B,U3,D:D,D3),0)" '派板-交板差異
  6. Range("V3:V" & xRow).Value = Range("V3:V" & xRow).Value
複製代碼

作者: jcchiang    時間: 2020-6-23 12:30

回復 69# PJChen

不是很懂你的意思!!
不是只是將公式放入欄位計算嗎???
後面的程式又改成每個項目單獨執行???
作者: 准提部林    時間: 2020-6-23 13:45

回復 69# PJChen

1) A欄月份2020..6有何做用??? 改成202006不是更直接, 排序也沒問題!

2) 公式是由上而下累計的, 指定日期可能會有誤差發生? 不太可靠!

3) =IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=1,SUMIFS(台中!$D:$D,台中!$B:$B,"大",台中!$A:$A,北區!$B3),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=2,SUMIFS(新竹!$D:$D,新竹!$B:$B,"大",新竹!$A:$A,北區!$B4),IF(COUNTIF(北區!$B$3:$B3,北區!$B3)=3,SUMIFS(南區!$D:$D,南區!$B:$B,"大",南區!$A:$A,北區!$B5),"")))
工作表只有"北區", 其它不見, 怎測試程式及公式???

提問前應再次確認給的資料及規則說明是否完整,
僅從公式及程式碼中去解讀需求規則, 是要花更多時間的~~
作者: jcchiang    時間: 2020-6-24 08:36

回復 69# PJChen
這個檔案資料都是在計算一些數值,如果是我自己要用,我覺得函數公式寫在儲存格下拉就解決了
因為實際的資料多寡只有你了解,加上部份資料也沒提供(准大提及部份),無法驗證
只能將你所提供的程式整理一下,至於其他所需的部份只能靠你自行增加囉!!

Sub 北區_A_EX()
Dim Sh As Worksheet, xS As Worksheet, xR
Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
Set Sh = Workbooks("全省核銷明細.xlsm").Sheets("北區")
d = xS.[AA3] 'Date
Sh.Activate
'------------ 'A 取B欄年.月
For Each xR In Range([b3], [b65535].End(3)) '向上 End(3) = End(xlup).Row
   If xR >= d Then
      xR.Offset(, -1) = Year(xR) & ".." & Month(xR)     'A 取B欄年.月
      xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8) '北區_K_結餘
      xR.Offset(, 22) = xR.Offset(-1, 22) + xR.Offset(, 5) + xR.Offset(, 8) - xR.Offset(, 6) - xR.Offset(, 7) - xR.Offset(, 21) '北區_X_派板結餘
      '-------------------------R欄無單號
      If xR.Offset(, 16) = "" Then
         xR.Offset(, 3) = "無交貨"
      Else
         xR.Offset(, 3) = xR.Offset(, 18) & xR.Offset(, 17) & xR.Offset(, 16) 'T&S&R
      End If
      '------------------------------供應商
      If xR.Offset(, 1) = "大" Then 'l+g-f+j-n
         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 5) - xR.Offset(, 4) + xR.Offset(, 8) - xR.Offset(, 12)
         xR.Offset(, 11) = xR.Offset(-1, 11) - xR.Offset(, 13)
      Else  '不是"大"應該就是"美"囉
         xR.Offset(, 10) = xR.Offset(-1, 10) + xR.Offset(, 8) - xR.Offset(, 12)
         xR.Offset(, 11) = xR.Offset(-1, 11) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 13)
      End If
      '------------------------------店名
      If xR.Offset(, 2) = "中和" Or xR.Offset(, 2) = "內湖" Or xR.Offset(, 2) = "汐止" Then
         xR.Offset(, 19) = xR
      Else
         xR.Offset(, 19) = xR + 1
      End If
      '-----------------------------盤點差異
      If xR.Offset(, 24) = "" Then
         xR.Offset(, 23) = ""
      Else 'z-x
         xR.Offset(, 23) = xR.Offset(, 24) - xR.Offset(, 22)
      End If
   End If
Next
End Sub
作者: 准提部林    時間: 2020-6-25 10:09

本帖最後由 准提部林 於 2020-6-25 10:11 編輯

很麻煩的表格~~如果每天都要處理~~很累吧!!!
公式之間有互相引用, 所以上面的方法都會出錯的~~
若用逐格填入~~不會快到哪???

看發帖的檔案有不少版本, 公司應有一定的規模, 為何不請專業的去設計?
時間就是金錢, 除了浪費時間精神體力外, 資料也可能算錯!!!
我們有空也只能稍幫幾許, 但總不能這樣無止境的做, 一切還是要靠自己~~

弄了兩種版本,
1) 字典+陣列版, 寫一半本想放棄, 因為可能(應該是)看不懂程式碼, 給了也沒用吧!! 太複雜~~
[attach]32227[/attach]

2) 輔助公式版, 能增進多少速度, 沒實測
[attach]32228[/attach]

所有的計算都從上面帖子中的公式用猜的(幾乎每次猜), 依樣畫葫, 自行去修正~~


======================================================
作者: PJChen    時間: 2020-6-25 22:22

本帖最後由 PJChen 於 2020-6-25 22:46 編輯

回復 73# 准提部林
感謝准大,
我會再抓時間測試

我們公司規模很小、很摳門,部門內所有檔案都由我設計,
看起來權限好像很大,但很累(這是個沒人想接的工作),
不過我有天馬行空的想像力,連做夢都會夢見excel、
夢見公式的運作,但能否實現,又是另一回事!
大部份的問題我都能自行解決,各位看到我發問,
其實只是冰山一角^.^
不過說到底是能力有限,能拼湊多少算多少囉...
作者: PJChen    時間: 2020-6-25 22:31

本帖最後由 PJChen 於 2020-6-25 22:43 編輯

回復 58# jcchiang

您好,
先說聲謝謝,你寫的程式,總是讓我得到很大的啟發
這段程式,我稍作修改,希望它可以自動對應,增加方便性,
但有些二個問題我無法解決...程式已寫入macro_D    [attach]32231[/attach]
macro_D的"理貨單"工作表,W1 & W2的對應值
x1 = xS.[w1] '對應 活動範圍a
x2 = xS.[w2] '對應檔名
For k = 1 To 7 (原7個檔,先用"下個月理貨單"資料夾的2個檔測試)
xS.[V1] = k
當xS.[w1]=1="暖暖1"
xS.[w2]="暖暖",則打開公用理貨含有"暖暖"字樣的檔案,
將理貨單II的B欄="暖暖1"的儲存格F:P的資料,
copy到"1"工作表的B3貼上值,
使用時發現程式copy資料並不是很快速
For Each a In Range("B:B")
If a = x1 Then d(a.Address) = d(a.Address)

所以我是用理貨單II的F:P區域覆蓋B:L,想使copy一次完成,
然後再將D:F,I:J的公式代入後下拉
現在遇到問題如下:
1) 雖然寫了
For k = 1 To 7
    xS.[V1] = k
但它只會打開第一個檔,我要如何讓它把"下個月理貨單"資料夾,全部檔都依序打開,
然後依k = 1 To 7,所對應的值貼到該貼的地方?

2) D:F,I:J的公式,key入後,希望出現公式,而不是值,例如:林口的檔案
I3值是50,但我希望程式
[i3] = "=" & "Int(" & [m3] & "/" & [L3] & ")" '箱數
[i3] 所得到的答案是公式=INT(M3/L3),
D:F,I:J...4欄也都希望呈現公式而非值
作者: PJChen    時間: 2020-6-28 11:20

回復 58# jcchiang
我已經解決問題囉...感謝
作者: PJChen    時間: 6 天前 19:35

本帖最後由 PJChen 於 2020-7-7 19:36 編輯

回復 42# 准提部林
准大好,
我用42樓的程式,修改後用來抓取客戶下單的"訂購數",修改後的程式如下:
  1. Sub 理貨訂購量()
  2. Dim Rw&, xR As Range, xH As Range, c%, Fx$
  3. Rw = Cells(Rows.Count, "K").End(xlUp).Row
  4. If Rw <= 2 Then Exit Sub
  5. '測試其中一個客戶的下單數...全都
  6. [q2] = "=SUMIFS(網單.全都!$I:$I,網單.全都!$C:$C,BF理貨!$D2," & _
  7. "網單.全都!$K:$K,BF理貨!$C2)+IF(BF理貨!$R$283=BF理貨!$B$283,BF理貨!$R2,0)"
  8. For Each xR In Range("K2:K" & Rw)
  9.     If xR = "品名" Then Set xH = xR(2, 7): c = 1: GoTo 101
  10.     If xR = "合計" Then
  11.        If c = 0 Then GoTo 101
  12.        With Range(xH, xR(0, 7)) 'Q欄填入公式
  13.             .FormulaR1C1 = [q2].FormulaR1C1
  14.             .Value = .Value
  15.             .Replace 0, "", 1  '*****(1,完全符合)
  16.        End With
  17.        c = 0
  18.     End If
  19. 101: Next
  20. [q2] = "訂購數"
  21. End Sub
複製代碼
問題如下:  [attach]32267[/attach]
a) Q欄的訂購數,是客戶下單的數量,收到訂單的時間都不是同時的
b) 客戶訂單名稱區分在A欄,客戶的訂單格式都不相同,所以6個客戶有6個公式抓取資料
c) 我修改了之前的一個程式,用來抓取Q欄的訂購數,但程式不是專為這個而設計,所以下一個客戶的訂單,會把前一訂單數給覆蓋
d) R欄的加減數量,是因應客戶有訂單"加量" or "減量"的需求而設,有時客人會在下單幾天前就告知,但不會修改當日訂單,所以需要用到R欄的"加減數量",
可以預先key入,但時間未到時則不予計入!
e) 請問要如何修改程式,可以將A欄名稱(客戶)列入程式中,讓不同時間下單的6個客戶,各自的訂單數不會被覆蓋?
''----------A欄名稱1) 全都
[q2] = "=SUMIFS(網單.全都!$I:$I,網單.全都!$C:$C,BF理貨!$D2," & _
"網單.全都!$K:$K,BF理貨!$C2)+IF(BF理貨!$R$283=BF理貨!$B$283,BF理貨!$R2,0)"
''----------A欄名稱2) 統統
[q2] = "=SUMIFS(網單.統統!$R:$R,網單.統統!$M:$M,BF理貨!$D2,網單.統統!$AC:$AC,BF理貨!$C2," & _
"網單.統統!$AE:$AE,BF理貨!$B$1)+IF(BF理貨!$R$1=BF理貨!$B$1,BF理貨!$R2,0)"
''----------A欄名稱3) 德QQK
'    [q2] = "=SUMIF(網單.德QQK!$E:$E,BF理貨!$D2,網單.德QQK!$G:$G)+IF(BF理貨!$R$388=BF理貨!$B$388,BF理貨!$R2,0)"
'''----------A欄名稱4) M社
'    [q2] = "=SUMPRODUCT((網單.M社!$R$2:$R$300=BF理貨!$D2)*(網單.M社!$AP$2:$AP$300))+IF(BF理貨!$R$561=BF理貨!$B$561,BF理貨!$R2,0)"
'''----------A欄名稱5) 得來
'    [q2] = "=SUMIFS(網單.得來!$L:$L,網單.得來!$H:$H,BF理貨!$D2,網單.得來!$O:$O,BF理貨!$C2)+IF(BF理貨!$R$420=BF理貨!$B$420,BF理貨!$R2,0)"
'''----------A欄名稱6) W康
'    [q2] = "=SUMPRODUCT((網單.W康!$C$6:$C$298=BF理貨!$D2)*(網單.W康!$D$6:$D$298))+IF(BF理貨!$R$508=BF理貨!$B$508,BF理貨!$R2,0)"
作者: 准提部林    時間: 5 天前 15:42

回復 77# PJChen

不研究公式是對或錯, 也沒法驗證, 照抄!!! 若有誤自行去修改  

Sub 理貨訂購量()
Dim Rw&, xR As Range, xD, xH As Range, c$, Fx$
Rw = Cells(Rows.Count, "K").End(xlUp).Row
If Rw <= 2 Then Exit Sub
Set xD = CreateObject("Scripting.Dictionary")
xD("全都") = "=SUMIFS(網單.全都!$I:$I,網單.全都!$C:$C,BF理貨!$D2," & _
           "網單.全都!$K:$K,BF理貨!$C2)+IF(BF理貨!$R$283=BF理貨!$B$283,BF理貨!$R2,0)"
xD("統統") = "=SUMIFS(網單.統統!$R:$R,網單.統統!$M:$M,BF理貨!$D2,網單.統統!$AC:$AC,BF理貨!$C2," & _
          "網單.統統!$AE:$AE,BF理貨!$B$1)+IF(BF理貨!$R$1=BF理貨!$B$1,BF理貨!$R2,0)"
xD("德QQK") = "=SUMIF(網單.德QQK!$E:$E,BF理貨!$D2,網單.德QQK!$G:$G)+IF(BF理貨!$R$388=BF理貨!$B$388,BF理貨!$R2,0)"
xD("M社") = "=SUMPRODUCT((網單.M社!$R$2:$R$300=BF理貨!$D2)*(網單.M社!$AP$2:$AP$300))+" & _
           "IF(BF理貨!$R$561=BF理貨!$B$561,BF理貨!$R2,0)"
xD("得來") = "=SUMIFS(網單.得來!$L:$L,網單.得來!$H:$H,BF理貨!$D2,網單.得來!$O:$O,BF理貨!$C2)" & _
           "+IF(BF理貨!$R$420=BF理貨!$B$420,BF理貨!$R2,0)"
xD("W康") = "=SUMPRODUCT((網單.W康!$C$6:$C$298=BF理貨!$D2)*(網單.W康!$D$6:$D$298))+" & _
           "IF(BF理貨!$R$508=BF理貨!$B$508,BF理貨!$R2,0)"

For Each xR In Range("K2:K" & Rw)
    If xR = "品名" Then Set xH = xR(2, 7): c = Range("A" & xR.Row): GoTo 101
    If xR = "合計" Then
       Fx = xD(c)
       If c = "" Or Fx = "" Then GoTo 101
       [Q2].Formula = Fx
       With Range(xH, xR(0, 7)) 'Q欄填入公式
            .FormulaR1C1 = [Q2].FormulaR1C1
            .Value = .Value
            .Replace 0, "", 1  '*****(1,完全符合)
       End With
       c = ""
    End If
101: Next
[Q2] = "訂購數"
End Sub


======================================
作者: PJChen    時間: 前天 21:47

回復 78# 准提部林

准大,
又來麻煩您了....
程式雖然來回查找,應該說測試了幾天,但沒有一次可以運作成功!就是找不到問題點...
我放上2個訂單,我想這2個可以運作的話,其他的應該就不會有問題了,
函數方面確定無誤,這是每天必做的功課,運行OK.  [attach]32279[/attach]
作者: 准提部林    時間: 昨天 10:41

回復 79# PJChen

改下:
If xR = "品名" Then Set xH = xR(2, 7): c = Range("A" & xR.Row + 1).Value: GoTo 101
作者: PJChen    時間: 昨天 13:13

回復 80# 准提部林

謝謝准大
可以正常運作了




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)