返回列表 上一主題 發帖

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

回復 4# PJChen


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

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


r = [F65535].End(3).Row > (3) = (xlup)
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 1# PJChen

Range("JQ4") = "=" & "AH4-BR4"
這只是簡單公式, 並不太耗效能,
除非行數太多,
甚至已有其它大量公式[正在引用]JQ欄, 所以才會拖累速度
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

.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))))"

字串連結用 & _
公式中有雙引號的"安", 須外加一對""安""
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 19# PJChen


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

Range("JQ4:JQ" & xRow) = "=IF(F4="""","""",AH4-BR4)"
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

回復 22# PJChen


上傳檔案好做事~~
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

兩種方案, 自行選用:
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
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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

'================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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


'=================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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


'==================================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

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


'==============================
EXCEL參考資料:
http://blog.xuite.net/smile1000mile/blog

TOP

        靜思自在 : 真正的愛心,是照顧好自己的這顆心。
返回列表 上一主題