[發問] 指定日期計算結餘數

PJChen

大大好,
請教
北區的資料是整年度的,資料會不斷增加,
B欄的日期>=VBA工作表的AF2
則計算K欄的結餘數
K3=k2+g3-f3-h3-i3+j3
原程式寫法是
For Each xR In Range([B3], [b65535].End(3))
    If xR >= d Then 'k+g-f-h-i+j
        xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
    End If
Next
結果會變成值,但有時需要保留公式,
並且我這種寫法,覺得不好用,
請問大大,如何改善程式?
需要有2種寫法
1. 計算後變成值
2. 計算後保留公式
核銷明細2021.rar (18.67 KB)

下載次數: 14

2021-9-22 21:19

samwang

回復 1# PJChen

請測試看看，謝謝

Sub test()
Dim d, R%
d = Sheets("VBA").[Af2]
R = [北區!a65536].End(3).Row
With [北區!k3].Resize(R - 2)
    .Formula = "=K2+G3-F3-H3-I3+J3"
    '.Value = .Value '轉為值
End With
End Sub

PJChen

回復 2# samwang

您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄<>美,則整列刪除
這是要單獨的程式....

PJChen

回復 2# samwang

另外,再請教

1) 為什麼程式,它能自動找到>=d的日期,進行計算呢?
d = Sheets("VBA").[Af2]

2) A欄,要取B欄的年月,YYYY..M
原先的寫法是
xR.Offset(, -1) = Year(xR) & ".." & Month(xR)
我套用現在新的程式,改為
.Formula = "=Format([b3], "YYYY") & ".." & Format([b3], "M")"
但無法帶出我要的值,請問要如何改這段？

PJChen

回復 2# samwang

您好,
我將K欄清空,反覆執行程式,發現它不會判別B欄>=d
d = Sheets("VBA").[Af2]
工作表日期是從6/1開始,假設當d=6/19
它無法找到B欄>=d的日期,再進行計算
而是永遠都從K3開始計算

samwang

回復 4# PJChen

1) 為什麼程式,它能自動找到>=d的日期,進行計算呢?
>> 不好意思，我沒注意到有這個條件，已更新如下，請測試看看，謝謝

2) A欄,要取B欄的年月,YYYY..M  
>> 已更新如下，謝謝

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
    Arr = .Value
    For i = 3 To UBound(Arr)
        .Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
        If Arr(i, 2) >= d Then
            .Cells(i, "k").Formula = "=R[-1]C+RC[-4]-RC[-5]-RC[-3]-RC[-2]+RC[-1] "
        End If
    Next
    '.Value = .Value '轉為值
End With
End Sub

samwang

回復  samwang

您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄美 ...
PJChen 發表於 2021-9-23 19:34

請測試看看，謝謝
Sub 刪除列()
Dim Arr, i&, j%, n%
With Sheets("北區")
    With Range(.[k3], .[a65536].End(3))
        Arr = .Value
        For i = 1 To UBound(Arr)
            If Arr(i, 3) <> "美" Then GoTo 99
            n = n + 1
            For j = 1 To UBound(Arr, 2)
                Arr(n, j) = Arr(i, j)
            Next
99:     Next
        .Clear
    End With
    With Range("a3").Resize(n, UBound(Arr, 2))
        .Value = Arr
        .Borders(xlBottom).Weight = xlHairline
    End With
End With
End Sub

samwang

回復  samwang

您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄美 ...
PJChen 發表於 2021-9-23 19:34

提供第2種刪除列方式，請測試看看，謝謝

Sub 刪除列2()
Dim xR As Range, xU As Range
For Each xR In Range("c3:c" & [c65536].End(3).Row).Rows
    If IsError(Application.Match("美", xR, 0)) Then
        If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
    End If
Next
If Not xU Is Nothing Then xU.EntireRow.Delete
End Sub

PJChen

回復 6# samwang

我之前的這種寫法,要修改的時候,就得一直算儲存格,讓我頭昏@@
xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
請問除了"RC"的寫法,還有其它方式嗎?

samwang

回復 9# PJChen

請測試看看，謝謝

Sub test()
Dim Arr, d, R%
d = Sheets("VBA").[Af2]
R = [北區!b65536].End(3).Row
With Sheets("北區").Range("a1:k" & R)
    With [a3].Resize(R - 2)
    .Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
    End With
    .Value = .Value '轉為值
    Arr = .Value
    For i = 3 To UBound(Arr)
        If Arr(i, 2) >= d Then
            .Cells(i, "k").Formula = "=k" & i - 1 & "+G" & i & "-F" & i & "-H" & i & "-I" & i & "+j" & i
        End If
    Next
    '.Value = .Value '轉為值
End With
End Sub