入黎免費幫你砌excel/教你formula同VBA

傅家俊

108 回覆
6 Like 1 Dislike
笑傲此生無厭倦 2024-12-11 06:00:37


想問下唔用VBA有冇可能做到呢個效果
個情況同打牌埋數一樣
有一堆人(幾個至十幾個不等)
有人應該收錢,有人應該畀錢
當然有個最簡單唔使用腦嘅方法就係負數嘅人直接過晒畀正數最大嗰條友,再由嗰條友過返數畀其餘正數嘅人

但而家想限於只有負數嘅人要向正數嘅人過數
想問下有冇formula做到
E.g.
A +88
B +24
C -40
D -72

感謝
咪L痴線喇 2024-12-15 20:41:46
可摸耳講下你想要嘅結果係點,d 要比a 72, c 要比16 阿a 同24 阿b?
笑傲此生無厭倦 2024-12-15 20:57:37
盡可能少次數嘅轉帳
可以係你個方法(3次),亦可以係上圖嘅方法(3次)
但原則係想只有負數嘅人要向正數嘅人轉帳
(唔想一條友負責集中收晒錢再過返畀其他人)
咪L痴線喇 2024-12-17 10:15:47
用VBA 應該簡單D, 但我VBA 好渣, 加多幾欄formula 都做到,唔知點copy 個Excel 上黎 ,

假設A column 係人名, B column 係數字, 第一個row 係title

C1 到H1 "Rank round 1", "1st trial payment","will cause over payment?","1st actual receipt","1st actual payment","bal after 1st payment

C2到H2"=RANK(B2,$B$2:$B$5)" , "=IF(AND(C2=MAX($C$2:$C$5),B2<MAX($B$2:$B$5)),B2,0)","=IF(ABS(D2)<MAX($B$2:$B$5),0,1)","=IF(E2=0,IF(C2=MIN($C$2:$C$5),-SUM($D$2:$D$5),0),MAX($B$2:$B$5))","=IF(D2<0,-MAX($F$2:$F$5),0)","=IF(B2-G2-F2=0," ",+B2-D2-F2)"

之後拉埋下面幾個row, 再copy 番呢幾個column 去右邊, 做第二同第三round payament, 咁就ok
笑傲此生無厭倦 2024-12-17 12:34:56
多謝師兄有心解答
啱啱試玩過第一round睇落work
第二三round可能因為啲$$位置問題所以似乎仲有啲問題
我應該可以自己加減調整的

欣賞你個思路
多謝師兄
連登有愛
咪L痴線喇 2024-12-17 12:49:15
pleasure, 將D $ 符號執下位就可以
Byeeee 2024-12-18 12:57:25
我想喺其中一格打啲野
隔離個格就自動出當刻嘅時間同埋日期
我set咗條公式=if(B2=“”,””,now())
但下一分鐘想打多個資料上面個時間就會變咗而家個時間
點樣set到個時間唔會變?Thx🙏
傅家俊 2024-12-18 17:20:20
因為formula會自動refresh, 數值先唔會
如果要exact效果, 要用VBA (下面會講)
但如果唔想用VBA, 可以用shortcut Ctrl + ; 直接出今日日期數值
又或者每日copy formula and paste value鎖定value

VBA就用以下code:
(Worksheet Tab上面right click --> view code, 然後貼code
要save做.xlsm)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A999")) Is Nothing Then '自己改個range
Target.Offset(0, 1).Value = Date
End If
End Sub
傅家俊 2024-12-18 17:23:51
Sorry, 睇漏左要連埋時間
時間Shortcut係 Ctrl+Shift+;
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A999")) Is Nothing Then '自己改個range
Target.Offset(0, 1).Value = Now()
End If
End Sub
六十路愛人 2024-12-24 09:46:27
請問有冇方法做到以下效果
係Page 1入資料
Column1 Cloumn2
AAAA 6
BBBB 3

Page 2就自動跳到
Column1 Column2
1 AAAA
2 AAAA
3 AAAA
4 AAAA
5 AAAA
6 AAAA
1 BBBB
2 BBBB
3 BBBB

如此類推
傅家俊 2024-12-25 01:49:50
Excel 365?
傅家俊 2024-12-25 03:17:28
發覺唔用textjoin texsplit好難寫
有無高手可以試下唔用?
我呢個方法如果去到3400行左右會Error
因為條text太長
=LET(
Col_A, Sheet1!$A:$A,
Col_B, Sheet1!$B:$B,
Col_A2, FILTER(Col_A, Col_A <> ""),
Col_B2, FILTER(Col_B, Col_B <> ""),
Output,TEXTSPLIT(TEXTJOIN(",",TRUE,MAP(Col_A2,Col_B2,LAMBDA(a,b,TEXTJOIN(",",TRUE,SEQUENCE(b) & ";" & a)))),";",","),
IF(ISNUMBER(--Output),--Output,Output))
北非看駱駝 2024-12-25 21:58:53
咸柑桔 2025-01-16 19:37:25
想問下我點樣可以任意輸入其中一欄數字就可以自動幫我計?

例如
A: 出發日 - 1/1/25 (C-E)
B: 出發日 week數 (show A week)
C: 到達日- 7/1/25 (A+E)
D: 到達日 week數 (show C week)
E: 行程日距 - 7 days

E就必定有入,但我想ABCD只要入一個,其餘三個就會自動計算
咪L痴線喇 2025-01-17 18:11:25
全部5個digit?如果係, 可以用left right + sum if
咪L痴線喇 2025-01-17 18:13:36
week 數係指成個行程第幾個week?
咸柑桔 2025-01-17 18:54:20
係,show第幾個week,但係唔識點樣

1. 輸入A,E,出BCD
2. 輸入B,E,出ACD
3. 輸入C,E,出ABD
4. 輸入D,E,出ABC

因為ABCD都有formula 的話就會error,我又唔想做4個表
傅家俊 2025-01-17 21:02:06
其實真係要100%做到你想要既功能, 要用VBA
但有D公司唔俾用, Web版又唔支援

唔用VBA可唔可以整兩個表?
一個for input, 一個for output
Output個表會有晒5個column
咁應該唔會有Error

VBA就可以用Cell change event一個表搞掂
睇你想唔想用VBA
傅家俊 2025-01-17 22:54:56
唔係太明week數
A係咪永遠都係1, 定係要累積埋之前?
C就去8-14日就2 week, 15-21日就3 week???
咸柑桔 2025-01-18 01:41:38
冇錯,即係一年有52 week, 1月1日係 week 1, 1月7日係week 2如此類推
傅家俊 2025-01-18 01:44:44
咁範圍有成7日
淨係入B,E or D,E點推到實際日子?
咸柑桔 2025-01-18 16:09:49
推到嗰個week既星期一出嚟我就ok
傅家俊 2025-01-20 03:24:45
寫左段VBA code
喺張sheet個tab度Right Click,揀 "View Code", 然後貼段code上去
之後喺Column A-E度輸入, 睇下效果
要save做.xlsm
你試下有無問題
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Finish
Dim r As Long
r = Target.Row

    If Intersect(Target, Range("A:E")) Is Nothing Or Not Range("E" & r).Value > 0 Then GoTo Finish
    
    
    If (Target.Column = 2 And Target.Value > 0) Or (Target.Column = 5 And Range("C" & r).Value > 0) Then
        Range("A" & r).Value = DateSerial(Year(Date), 1, 1) + Range("B" & r).Value * 7 - 1
        Range("C" & r).Value = Range("A" & r).Value + Range("E" & r).Value - 1
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
    
    ElseIf (Target.Column = 4 And Target.Value > 0) Or (Target.Column = 5 And Range("D" & r).Value > 0) Then
        Range("C" & r).Value = DateSerial(Year(Date), 1, 1) + Range("D" & r).Value * 7 - 1
        Range("A" & r).Value = Range("C" & r).Value - Range("E" & r).Value + 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)

    
    ElseIf (Target.Column = 1 And Target.Value > 0) Or (Target.Column = 5 And Range("A" & r).Value > 0) Then
        Range("C" & r).Value = Range("A" & r).Value + Range("E" & r).Value - 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        
        
    ElseIf (Target.Column = 3 And Target.Value > 0) Or (Target.Column = 5 And Range("B" & r).Value > 0) Then
        Range("A" & r).Value = Range("C" & r).Value - Range("E" & r).Value + 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
    End If

Finish:
    On Error GoTo 0
    Application.EnableEvents = True
End Sub
傅家俊 2025-01-20 03:26:19
睇漏左要星期一
等一陣我改少少
傅家俊 2025-01-20 08:08:32
而家應該OK
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Finish
Dim r As Long
r = Target.Row

    If Intersect(Target, Range("A:E")) Is Nothing Or Not Range("E" & r).Value > 0 Then GoTo Finish
    
    
    If (Target.Column = 2 And Target.Value > 0) Or (Target.Column = 5 And Range("C" & r).Value > 0) Then
        Range("A" & r).Value = DateSerial(Year(Date), 1, 1) + Range("B" & r).Value * 7 - 1
        Range("A" & r).Value = Range("A" & r).Value - (Weekday(Range("A" & r).Value, 2) - 1)
        Range("C" & r).Value = Range("A" & r).Value + Range("E" & r).Value - 1
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
    
    ElseIf (Target.Column = 4 And Target.Value > 0) Or (Target.Column = 5 And Range("D" & r).Value > 0) Then
        Range("C" & r).Value = DateSerial(Year(Date), 1, 1) + Range("D" & r).Value * 7 - 1
        Range("C" & r).Value = Range("C" & r).Value - (Weekday(Range("C" & r).Value, 2) - 1)
        Range("A" & r).Value = Range("C" & r).Value - Range("E" & r).Value + 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)

    
    ElseIf (Target.Column = 1 And Target.Value > 0) Or (Target.Column = 5 And Range("A" & r).Value > 0) Then
        Range("C" & r).Value = Range("A" & r).Value + Range("E" & r).Value - 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        
        
    ElseIf (Target.Column = 3 And Target.Value > 0) Or (Target.Column = 5 And Range("B" & r).Value > 0) Then
        Range("A" & r).Value = Range("C" & r).Value - Range("E" & r).Value + 1
        Range("B" & r).Value = WorksheetFunction.RoundUp((Range("A" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
        Range("D" & r).Value = WorksheetFunction.RoundUp((Range("C" & r).Value - DateSerial(Year(Range("A" & r).Value), 1, 1) + 1) / 7, 0)
    End If

Finish:
    On Error GoTo 0
    Application.EnableEvents = True
End Sub
吹水台自選台熱 門最 新手機台時事台政事台World體育台娛樂台動漫台Apps台遊戲台影視台講故台健康台感情台家庭台潮流台美容台上班台財經台房屋台飲食台旅遊台學術台校園台汽車台音樂台創意台硬件台電器台攝影台玩具台寵物台軟件台活動台電訊台直播台站務台黑 洞