返回列表 上一主題 發帖

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

回復 60# 准提部林

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

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

理貨單3.rar (324.35 KB)

TOP

回復 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欄為公式, 很麻煩~~
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 62# 准提部林

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

TOP

回復 58# jcchiang

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

TOP

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

回復 65# PJChen


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

1) 允收日怎麼算的, 自行修改
2) 理貨公式, 版本不合, 做不了
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 66# 准提部林

謝謝准大,
執行沒問題

TOP

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

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

TOP

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

TOP

回復 69# PJChen

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

TOP

        靜思自在 : 心中常存善解、包容、感思、知足、惜福。
返回列表 上一主題