- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 0
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-14
|
2#
發表於 2014-9-6 03:25
| 只看該作者
本帖最後由 luhpro 於 2014-9-6 03:28 編輯
今天在工作中接到一個令我想不出辦法的難題,不知是否有人能提供好方法
請教各位,有這樣的公式可寫嗎?
kyotogoeric 發表於 2014-9-4 21:12
若想要現成的沒有,
因為 Excel 系統自帶的公式其作用主體為 "儲存格", 沒有針對其內個別文數字做處理的公式.
不過可以自己做一個 : 底下函數使用的方式為 : =CompNumber(A1,B1) , 傳回值為布林值- Function CompNumber(rng1 As Range, rng2 As Range) As Boolean
- Dim iNum1%, iNum2%, iPos%, iLen%
- Dim rTar As Range
-
- CompNumber = False
- Set rTar = rng1
- iLen = Len(rTar)
- For iPos = 1 To iLen
- With rTar.Characters(Start:=iPos, Length:=2).Font
- If .ColorIndex = 3 Then Exit For
- End With
- Next
- If iPos <> iLen Then
- iNum1 = CInt(Mid(rTar, iPos, 2))
- Else
- Exit Function
- End If
-
- Set rTar = rng2
- iLen = Len(rTar)
- For iPos = 1 To iLen
- With rTar.Characters(Start:=iPos, Length:=2).Font
- If .ColorIndex = 3 Then Exit For
- End With
- Next
- If iPos <> iLen Then
- iNum2 = CInt(Mid(rTar, iPos, 2))
- Else
- Exit Function
- End If
-
- If iNum1 = iNum2 Then CompNumber = True
- End Function
複製代碼 而若想當比對不符就直接將文字變為紅色 :- Private Sub cbComp_Click()
- ChkNum [A1], [B1]
- End Sub
- Sub ChkNum(rng1 As Range, rng2 As Range)
- Dim iNum1%, iNum2%, iPos%, iLen%
- Dim lRow&
- Dim rTar As Range
-
- Set rTar = rng1
- lRow = 0
- While rng1.Offset(lRow) <> ""
- iLen = Len(rTar)
- For iPos = 1 To iLen
- With rTar.Characters(Start:=iPos, Length:=2).Font
- If .ColorIndex = 3 Then Exit For
- End With
- Next
- If iPos <> iLen Then
- iNum1 = CInt(Mid(rTar, iPos, 2))
- Else
- Exit Sub
- End If
-
- Set rTar = rng2.Offset(lRow)
- iLen = Len(rTar)
- For iPos = 1 To iLen
- With rTar.Characters(Start:=iPos, Length:=2).Font
- If .ColorIndex = 3 Then Exit For
- End With
- Next
- If iPos <> iLen Then
- iNum2 = CInt(Mid(rTar, iPos, 2))
- Else
- Exit Sub
- End If
-
- If iNum1 <> iNum2 Then
- rng1.Offset(lRow).Font.ColorIndex = 3
- rng2.Offset(lRow).Font.ColorIndex = 3
- End If
- lRow = lRow + 1
- Set rTar = rng1.Offset(lRow)
- Wend
- End Sub
複製代碼
數字比對-a.zip (12.46 KB)
|
|