PJChen

　暱稱: PJ

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

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-9-22 21:20 | 只看該作者

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

大大好,
請教
北區的資料是整年度的,資料會不斷增加,
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)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

2^#

發表於 2021-9-23 07:31 | 只看該作者

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2021-9-23 19:34 | 只看該作者

回復 2# samwang

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2021-9-23 21:05 | 只看該作者

回復 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")"
但無法帶出我要的值,請問要如何改這段？

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2021-9-23 21:40 | 只看該作者

回復 2# samwang

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

6^#

發表於 2021-9-24 07:57 | 只看該作者

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

7^#

發表於 2021-9-24 10:31 | 只看該作者

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

8^#

發表於 2021-9-24 10:45 | 只看該作者

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

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

論壇榮譽勳章論壇贊助勳章

9^#

發表於 2021-9-24 20:32 | 只看該作者

回復 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"的寫法,還有其它方式嗎?

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

10^#

發表於 2021-9-25 09:53 | 只看該作者

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

TOP