標題:
條件式格式設定
[打印本頁]
作者:
198188
時間:
2024-2-27 11:59
標題:
條件式格式設定
根據Invoice 表 的欄C - E 找Data表 的欄 A - C 資料相同的
Invoice 表 的欄C 對比 Data表 的欄 A
Invoice 表 的欄D 對比 Data表 的欄 B
Invoice 表 的欄E 對比 Data表 的欄 C
如果3個都相同,讀取Data表 的欄 E 到 Invoice 表的欄J
Invoice 表的欄K = 欄J - 欄F (答案是正數,字體變藍色,答案是負數,字體變紅色)
Invoice 表的欄L = ROUND (欄D * 欄E / 1000000,3)
Invoice 表的欄M =欄L - 欄G (答案不等於0,字體紅色)
Invoice 表的欄N= ROUND (欄L * 欄F,3)
Invoice 表的欄O =欄N - 欄H (答案不等於0,字體紅色)
作者:
Andy2483
時間:
2024-2-27 14:34
本帖最後由 Andy2483 於 2024-2-27 15:20 編輯
回復
1#
198188
謝謝前輩發表此主題與範例
後學藉此帖學到了 ROUND() 很多知識,學習方案如下,請前輩參考
https://learn.microsoft.com/zh-t ... help/round-function
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, Q, i&, j%, R&, c%, Y&, X%, T$, T1$, T2$, T3$
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Data!E2], [Data!A65536].End(3))
For i = 1 To UBound(Brr)
T = Trim(Brr(i, 1)) & "/" & Val(Brr(i, 2)) & "/" & Val(Brr(i, 3))
If Z.EXISTS(T) Then
MsgBox T & "重複": Exit Sub
Else
Z(T) = Val(Brr(i, 5))
Z(T & "/n") = 1
End If
Next
Arr = Range([Invoice!H12], [Invoice!C65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
If Trim(Arr(i, 1)) = "" Then GoTo i01
T = Trim(Arr(i, 1)) & "/" & Val(Arr(i, 2)) & "/" & Val(Arr(i, 3))
Z(T & "/n") = Z(T & "/n") + 1
If Z(T & "/n") > 2 Then MsgBox T & "重複": Exit Sub Else V = Z(T)
If V = "" Then GoTo i01
Crr(i, 1) = V
Crr(i, 2) = V - Val(Arr(i, 4))
Crr(i, 3) = Application.Round(Val(Arr(i, 2)) * Val(Arr(i, 3)) / 10 ^ 6, 3)
Crr(i, 4) = Crr(i, 3) - Val(Arr(i, 5))
Crr(i, 5) = Application.Round(Crr(i, 3) * Val(Arr(i, 4)), 3)
Crr(i, 6) = Crr(i, 5) - Val(Arr(i, 6))
i01: Next
[Invoice!J12].Resize(UBound(Crr), 6) = Crr
End Sub
作者:
198188
時間:
2024-2-27 15:06
回復
2#
Andy2483
如果中間有兩三個空行,這個需要怎樣改,才能計算最後一行
[attach]37514[/attach]
Arr = Range([Invoice!H12], [Invoice!C65536].End(3))
作者:
Andy2483
時間:
2024-2-27 15:19
回復
3#
198188
Sorry
ReDim Crr放錯位置了,請看2#的修正
作者:
198188
時間:
2024-2-27 16:30
回復
4#
Andy2483
我在這�堨[了一句改顔色,我用了下面5個方式,都是錯,請問是哪�堣ㄨ鵅H
Crr(i, 2) = V - Val(Arr(i, 4))
If Crr(i, 2) > 0 Then Crr(i, 2).Font.ColorIndex = 3
If Crr(i, 2) > 0 Then Crr(i, 2).Font.ColorIndex = RGB(205, 238, 202)
If Crr(i, 2) > 0 Then Worksheets("Invoice").Range("K" & i).Font.ColorIndex = 3
If Crr(i, 2) > 0 Then Worksheets("Invoice").Range("K" & i).Font.ColorIndex = RGB(205, 238, 202)
If Crr(i, 2) = 0 then Crr(i, 2).Font.ColorIndex = 6 else Crr(i, 2) > 0 Then Crr(i, 2).Font.ColorIndex = 3 else Crr(i, 2).Font.ColorIndex = 4
作者:
Andy2483
時間:
2024-2-27 16:40
回復
5#
198188
建議前輩不要從裡面改,讓陣列值貼入儲存格後寫另一段代碼判斷值再變更字色
因儲存格索引號與陣列索引號錯位,容易混淆
作者:
198188
時間:
2024-2-27 16:42
回復
6#
Andy2483
明白,謝謝。
作者:
准提部林
時間:
2024-2-28 09:56
文字顏色可直接用格式設定即可,
建議
預先
設定好表格格式, 儘量不要在程式中逐一設置, 拖慢速度,
K欄//[藍色]0_ ;[紅色]-0 ;[黑色]0
M.O欄//[紅色][<>0]0.000;[黑色]0.000 或 [黑色][=0]0.000;[紅色]0.000
條件格式也可以, 這很基本的, 應該可以自己來~~
作者:
198188
時間:
2024-2-28 10:39
回復
8#
准提部林
了解,我已經做了格式設定
作者:
198188
時間:
2024-2-28 10:47
回復
8#
准提部林
准大,開否幫我看看這個貼
https://forum.twbts.com/viewthread.php?tid=24205&pid=123061&page=1&extra=pageD1#pid123061
作者:
198188
時間:
2024-2-28 11:27
回復
2#
Andy2483
我加了一句 刪除之前的資料,和修改了H10 & J10 為開始
Option Explicit
Sub TEST2()
Dim Arr, Brr, Crr, V, Z, Q, i&, j%, R&, c%, Y&, X%, T$, T1$, T2$, T3$
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Range([O10], [J65536].End(xlUp)(3)).Delete Shift:=xlUp
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Data!E2], [Data!A65536].End(3))
For i = 1 To UBound(Brr)
T = Trim(Brr(i, 1)) & "/" & Val(Brr(i, 2)) & "/" & Val(Brr(i, 3))
If Z.EXISTS(T) Then
MsgBox T & "Repeat": Exit Sub
Else
Z(T) = Val(Brr(i, 5))
Z(T & "/n") = 1
End If
Next
Arr = Range([Invoice!H10], [Invoice!C65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
If Trim(Arr(i, 1)) = "" Then GoTo i01
T = Trim(Arr(i, 1)) & "/" & Val(Arr(i, 2)) & "/" & Val(Arr(i, 3))
Z(T & "/n") = Z(T & "/n") + 1
If Z(T & "/n") > 2 Then MsgBox T & "Repeat": Exit Sub Else V = Z(T)
If V = "" Then GoTo i01
Crr(i, 1) = V
Crr(i, 2) = V - Val(Arr(i, 4))
Crr(i, 3) = Application.Round(Val(Arr(i, 2)) * Val(Arr(i, 3)) / 10 ^ 6, 3)
Crr(i, 4) = Crr(i, 3) - Val(Arr(i, 5))
Crr(i, 5) = Application.Round(Crr(i, 3) * Val(Arr(i, 4)), 3)
Crr(i, 6) = Crr(i, 5) - Val(Arr(i, 6))
i01: Next
[Invoice!J10].Resize(UBound(Crr), 6) = Crr
End Sub
作者:
Andy2483
時間:
2024-2-29 07:41
回復
11#
198188
謝謝前輩一起學習
後學複習方案心得註解如下,請試了解後運用
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, T$
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Brr = Range([Data!E2], [Data!A65536].End(3))
'↑令Brr變數是二維陣列,以工作表範圍儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈!
T = Trim(Brr(i, 1)) & "/" & Val(Brr(i, 2)) & "/" & Val(Brr(i, 3))
'↑令T變數是1欄字串.2欄數值與3欄數值以"/"符號串接成的新字串
If Z.EXISTS(T) Then
'↑如果Z字典裡有T變數這key
MsgBox T & "重複": Exit Sub
'↑代表資料有重複,跳出提示窗,按確定後結束程式執行
Else
'否則
Z(T) = Val(Brr(i, 5))
'↑令以T變數為key,5欄數值為item 納入Z字典中
Z(T & "/n") = 1
'↑令以T變數連接"/n"組成的新字串為key,1為item 納入Z字典中
End If
Next
Arr = Range([Invoice!H12], [Invoice!C65536].End(3))
'↑令Arr變數是二維陣列,以工作表範圍儲存格值帶入
ReDim Crr(1 To UBound(Arr), 1 To 6)
'↑宣告Crr變數是二維空陣列,並宣告其範圍
For i = 1 To UBound(Arr)
'↑設順迴圈!
If Trim(Arr(i, 1)) = "" Then GoTo i01
'↑如果1欄陣列值去除頭尾空白字元後 是空字元,就跳到標示i01位置繼續執行
T = Trim(Arr(i, 1)) & "/" & Val(Arr(i, 2)) & "/" & Val(Arr(i, 3))
Z(T & "/n") = Z(T & "/n") + 1
'↑令item值累加1
If Z(T & "/n") > 2 Then MsgBox T & "重複": Exit Sub Else V = Z(T)
'↑代表資料有重複,跳出提示窗,按確定後結束程式執行,否則就令V變數是以T變數查Z字典得到的item值
If V = "" Then GoTo i01
'↑如果V變數是空字元,就跳到標示i01位置繼續執行
Crr(i, 1) = V
Crr(i, 2) = V - Val(Arr(i, 4))
Crr(i, 3) = Application.Round(Val(Arr(i, 2)) * Val(Arr(i, 3)) / 10 ^ 6, 3)
Crr(i, 4) = Crr(i, 3) - Val(Arr(i, 5))
Crr(i, 5) = Application.Round(Crr(i, 3) * Val(Arr(i, 4)), 3)
Crr(i, 6) = Crr(i, 5) - Val(Arr(i, 6))
'↑令以Arr陣列值依需求計算後帶入 Crr陣列中
i01: Next
[Invoice!J12].Resize(UBound(Crr), 6) = Crr
'↑令Crr陣列值寫入儲存格中
End Sub
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)