123456789
返回列表 上一主題 發帖

[發問] 讓公式的值,直接帶入儲存格

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
61# 跳轉到 »
發表於 2020-5-23 21:39 | 只看該作者
回復 60# 准提部林

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

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

理貨單3.rar (324.35 KB)

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-6-9 
62#
發表於 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欄為公式, 很麻煩~~

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
63#
發表於 2020-5-24 20:06 | 只看該作者
回復 62# 准提部林

准大,
測試結果已可正常執行,謝謝！

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
64#
發表於 2020-5-25 23:30 | 只看該作者
回復 58# jcchiang

感謝百忙中抽空幫忙,這幾天測試程式已可運作！

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
65#
發表於 2020-5-29 00:06 | 只看該作者
回復 62# 准提部林

准大好,

理貨單依需求增加小計欄位後,無法正常運作,可否幫忙看看!   理貨單_例外.rar (24.08 KB)
需要修改以下
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
複製代碼

TOP

准提部林

帖子
2843 
主題
10 
精華
0 
積分
2899 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2025-6-9 
66#
發表於 2020-5-30 13:19 | 只看該作者
回復 65# PJChen


Xl0000190(箱瓶允收日)v01.rar (27.21 KB)

1) 允收日怎麼算的, 自行修改
2) 理貨公式, 版本不合, 做不了

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
67#
發表於 2020-5-31 22:21 | 只看該作者
回復 66# 准提部林

謝謝准大,
執行沒問題

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
68#
發表於 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 = "盤點差異"
卻不知如何下手,以下是原程式, 可否幫忙看下,要如何修改?   全省核銷明細.rar (35.18 KB)
  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

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

  22. 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)"
  23. Range("L3:L" & xRow).Value = Range("L3:L" & xRow).Value

  25. 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)"
  26. Range("M3:M" & xRow).Value = Range("M3:M" & xRow).Value

  28. 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),"")))"
  29. Range("N3:N" & xRow).Value = Range("N3:N" & xRow).Value

  31. 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),"")))"
  32. Range("O3:O" & xRow).Value = Range("O3:O" & xRow).Value

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

  37. 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)" '派板-交板數差異
  38. Range("V3:V" & xRow).Value = Range("V3:V" & xRow).Value

  40. 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))" '派板結餘
  41. Range("X3:X" & xRow).Value = Range("X3:X" & xRow).Value

  43. Range("Y3:Y" & xRow).Formula = "=盤點差異"
  44. Range("Y3:Y" & xRow).Value = Range("Y3:Y" & xRow).Value
  45. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
69#
發表於 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

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

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

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

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

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

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

  108. Sub 北區_Y_盤點差異()
  109. Dim Sh As Worksheet, xS As Worksheet, xR
  110. Set xS = ThisWorkbook.Sheets("VBA")  '程式來源
  111. Set Sh = Workbooks("全省核銷明細.xlsx").Sheets("北區")
  112. d = xS.[AA3] 'Date
  113. Sh.Activate
  114. '------------ 'Y'盤點差異
  115. For Each xR In Range([b3], [b65535].End(3))
  116.     If xR >= d And xR.Offset(, 24) = "" Then
  117.         xR.Offset(, 23) = ""
  118.         Else 'z-x
  119.         xR.Offset(, 23) = xR.Offset(, 24) - xR.Offset(, 22)
  120.     End If
  121. Next
  122. 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

  4. 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),"")))
  5. Range("O3:O" & xRow).Value = Range("O3:O" & xRow).Value

  7. 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)" '派板-交板差異
  8. Range("V3:V" & xRow).Value = Range("V3:V" & xRow).Value
複製代碼

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
70#
發表於 2020-6-23 12:30 | 只看該作者
回復 69# PJChen

不是很懂你的意思!!
不是只是將公式放入欄位計算嗎???
後面的程式又改成每個項目單獨執行???

TOP

        靜思自在 : 要比誰更受誰．不要比誰更怕誰。
123456789
返回列表 上一主題