指定日期計算結餘數
大大好,請教
北區的資料是整年度的,資料會不斷增加,
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. 計算後保留公式
[attach]34052[/attach] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116947&ptid=23374]1#[/url] [i]PJChen[/i] [/b]
請測試看看，謝謝
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 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116948&ptid=23374]2#[/url] [i]samwang[/i] [/b]
您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄<>美,則整列刪除
這是要單獨的程式.... [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116948&ptid=23374]2#[/url] [i]samwang[/i] [/b]
另外,再請教
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")"
但無法帶出我要的值,請問要如何改這段？ [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116948&ptid=23374]2#[/url] [i]samwang[/i] [/b]
您好,
我將K欄清空,反覆執行程式,發現它不會判別B欄>=d
d = Sheets("VBA").[Af2]
工作表日期是從6/1開始,假設當d=6/19
它無法找到B欄>=d的日期,再進行計算
而是永遠都從K3開始計算 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116952&ptid=23374]4#[/url] [i]PJChen[/i] [/b]
1) 為什麼程式,它能自動找到>=d的日期,進行計算呢?
[color=Blue]>> 不好意思，我沒注意到有這個條件，已更新如下，請測試看看，謝謝[/color]
2) A欄,要取B欄的年月,YYYY..M
[color=Blue]>> 已更新如下，謝謝[/color]
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 [quote]回復 samwang
您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄美 ...
[size=2][color=#999999]PJChen 發表於 2021-9-23 19:34[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116950&ptid=23374][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]
請測試看看，謝謝
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 [quote]回復 samwang
您好,
測試沒問題,另外想請教
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄美 ...
[size=2][color=#999999]PJChen 發表於 2021-9-23 19:34[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116950&ptid=23374][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]
提供第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 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116954&ptid=23374]6#[/url] [i]samwang[/i] [/b]
我之前的這種寫法,要修改的時候,就得一直算儲存格,讓我頭昏@@
xR.Offset(, 9) = xR.Offset(-1, 9) + xR.Offset(, 5) - xR.Offset(, 4) - xR.Offset(, 6) - xR.Offset(, 7) + xR.Offset(, 8)
請問除了"RC"的寫法,還有其它方式嗎? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116973&ptid=23374]9#[/url] [i]PJChen[/i] [/b]
請測試看看，謝謝
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 [i=s] 本帖最後由 samwang 於 2021-9-25 16:16 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116973&ptid=23374]9#[/url] [i]PJChen[/i] [/b]
不好意思，請教一下您既然要用VBA為什麼還在Excel寫公式?
後學覺得用VBA在excel寫公式怪怪的，
直接在excel寫入公式，這樣不就好了嗎? [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116950&ptid=23374]3#[/url] [i]PJChen[/i] [/b]
同一個檔案
C欄"供應商"分為大 & 美
從第3列開始,C欄<>美,則整列刪除
這是要單獨的程式....
[color=Blue]>> 請問#7、#8可以用嗎? [/color] [i=s] 本帖最後由 PJChen 於 2021-9-25 21:11 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116979&ptid=23374]11#[/url] [i]samwang[/i] [/b]
您是指K3=K2+G3-F3-H3-I3+J3的公式嗎?
這是為了讓回覆者知道要如何計算
[color=Red]如果是指這個的話,因為我不會其他寫法,用了一段時間後,又要想學其他方式,
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[/color]
我最想學的是陣列方式,所以求教會寫的人
我常看准大的程式,但我資質不好,一直沒學會,
現在這個檔,每一欄計算,我都使用單獨的程式,
像前面的問題
A欄,要取B欄的年月,YYYY..M
我原先也是單獨的寫法,但我沒想到你把二個需求併在一起了
我想把這個檔,每個需要計算的欄位,都轉換為陣列寫法,
因為只寫一欄的計算比較沒那麼複雜,
希望看別人的程式後,可以學得一招半式！
我再自行修改,遇到改不出來再提問,
我不太清楚是否每種需求都可以用陣列...
這只是我心裡想的！ [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116982&ptid=23374]12#[/url] [i]samwang[/i] [/b]
這二個程式執行後
都正確！ [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116974&ptid=23374]10#[/url] [i]samwang[/i] [/b]
#6
.Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
這段程式,都只能從第3列往下寫
#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
這段程式,無法截取B欄資料,將YYYY..M填入A欄 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116986&ptid=23374]15#[/url] [i]PJChen[/i] [/b]
#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
這段程式,無法截取B欄資料,將YYYY..M填入A欄
[color=Blue]>> With [a3].Resize(R - 2)
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
End With
.Value = .Value '轉為值
這功能正常，這是將B欄資料沒經過條件轉為 "2021..6 "[/color]
如過您的需求是要經過日期比較，請自行將 .Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
移到if 底下
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, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
.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
[color=Blue]請在測試看看，謝謝[/color] [i=s] 本帖最後由 samwang 於 2021-9-26 06:39 編輯 [/i]
[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116986&ptid=23374]15#[/url] [i]PJChen[/i] [/b]
#10
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
這段程式,無法截取B欄資料,將YYYY..M填入A欄
[color=Green][color=Blue]>> With [a3].Resize(R - 2)
.Formula = "=YEAR(B3) & "".."" & MONTH(B3)"
End With
.Value = .Value '轉為值
這功能正常，這是將B欄資料沒經過條件轉為 "2021..6 "[/color][/color]
[color=Blue]如過您的需求是要經過日期比較，請自行將 .Cells(i, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
移到if 底下如下
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, "a").Formula = "=YEAR(RC[1]) & "".."" & MONTH(RC[1])"
.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
[color=Blue]請在測試看看，謝謝[/color][/color] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116988&ptid=23374]17#[/url] [i]samwang[/i] [/b]
測試沒問題了！
再請問同一檔案,另一段程式 [attach]34068[/attach]
E欄要填入單號(連結)T&S&R
但R欄=""時,則E欄="無交貨"
請問要如何改這段程式?
If Arr(i, 2) >= d And Arr(i, "r") = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
.Cells(i, "e").Formula = "無交貨"
Else
.Cells(i, "e").Formula = "=T&S&R"
End If
Next [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116988&ptid=23374]17#[/url] [i]samwang[/i] [/b]
另外一個U欄程式,紅字這一段,日期+1的寫法不能用,請問如何讓日期+1
例如:u3=8/3,則+1=8/4
For i = 3 To UBound(Arr)
[color=Red] If Arr(i, 2) >= d And Arr(i, 4) <> "中和" Or Arr(i, 4) <> "內湖" And Arr(i, 4) <> "汐止" Then 'i=列
.Cells(i, "u").Formula = "=Arr(i, 2)" + 1[/color]
ElseIf Arr(i, 2) >= d And Arr(i, 4) = "中和" Or Arr(i, 4) = "內湖" And Arr(i, 4) = "汐止" Then
.Cells(i, "u").Formula = "Arr(i, 2)"
End If
Next [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=116992&ptid=23374]18#[/url] [i]PJChen[/i] [/b]
E欄要填入單號(連結)T&S&R
但R欄=""時,則E欄="無交貨"
請問要如何改這段程式?
[color=Blue]>> 依據您的程式做修改如下
If Arr(i, 2) >= d And Arr(i, 18) = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
[color=Red] .Cells(i, "e") = "無交貨"[/color]
Else
[color=Red] .Cells(i, "e").Formula = "=T" & i & " & S" & i & "& R" & i & ""[/color]
End If[/color]
[color=Blue]但是依據您的描述，後學覺得條件可以拆成2段if 比較好，謝謝
If Arr(i, 2) >= d And Arr(i, 18) = "" Then 'Arr(i, 2),第2欄是日期,R欄無單號
.Cells(i, "e") = "無交貨"
end if
If Arr(i, 2) >= d And Arr(i, 18) <> "" Then
.Cells(i, "e").Formula = "=T" & i & " & S" & i & "& R" & i & ""
end if
[/color]