返回列表 上一主題 發帖

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

回復 35# PJChen

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

TOP

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


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

TOP

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


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

TOP

回復 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] = ""
__這裡只取代"品名(下一格)"到"合計(上一格)"之間的範圍

TOP

回復 45# PJChen

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

TOP

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


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

TOP

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

TOP

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

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欄為公式, 很麻煩~~

TOP

回復 65# PJChen


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

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

TOP

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