198188

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 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，字體紅色）

範例B.rar (133.09 KB)

樓主熱帖

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

12^#

發表於 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

11^#

發表於 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

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

10^#

發表於 2024-2-28 10:47 | 只看該作者

回復 8# 准提部林

准大，開否幫我看看這個貼
https://forum.twbts.com/viewthread.php?tid=24205&pid=123061&page=1&extra=pageD1#pid123061

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

9^#

發表於 2024-2-28 10:39 | 只看該作者

回復 8# 准提部林

了解，我已經做了格式設定

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2839
主題: 10
精華: 0
積分: 2895
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-12-27

8^#

發表於 2024-2-28 09:56 | 只看該作者

文字顏色可直接用格式設定即可,
建議預先設定好表格格式, 儘量不要在程式中逐一設置, 拖慢速度,
K欄//[藍色]0_ ;[紅色]-0 ;[黑色]0
M.O欄//[紅色][<>0]0.000;[黑色]0.000 或 [黑色][=0]0.000;[紅色]0.000

條件格式也可以, 這很基本的, 應該可以自己來~~

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

7^#

發表於 2024-2-27 16:42 | 只看該作者

回復 6# Andy2483

明白，謝謝。

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

6^#

發表於 2024-2-27 16:40 | 只看該作者

回復 5# 198188

建議前輩不要從裡面改,讓陣列值貼入儲存格後寫另一段代碼判斷值再變更字色
因儲存格索引號與陣列索引號錯位,容易混淆

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

198188

高中生 Rank: 3 Rank: 3

帖子: 438
主題: 67
精華: 0
積分: 531
點名: 30
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2012-10-30
最後登錄: 2024-11-19

5^#

發表於 2024-2-27 16:30 | 只看該作者

回復 4# Andy2483

我在這裏加了一句改顔色，我用了下面5個方式，都是錯，請問是哪裏不對？

   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

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

4^#

發表於 2024-2-27 15:19 | 只看該作者

回復 3# 198188

Sorry
ReDim Crr放錯位置了,請看2#的修正

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP