iT邦幫忙

0

請問excel vba能把包含韓文的欄位儲存格顏色改為黃色嗎?

  • 分享至 

  • xImage

請問有辦法篩選出欄位包含韓文的
A列大概會處理4000筆以上資料
例如(因為我怕圖床壞了所以我自己畫了一個簡陋的,請見諒)
a1
123中文
456굿모닝 ←變黃色欄位
abc123

圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中
1
海綿寶寶
iT邦大神 1 級 ‧ 2022-02-17 15:37:56
最佳解答

沒有測過
Try Try 看

Sub Main()
    Range("A1").Select
    Do While ActiveCell.Value <> ""
        If hasDBCS(ActiveCell) Then
            With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
        Else
            Selection.Interior.ColorIndex = xlNone
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub
Function hasDBCS(ByVal str As String) As Boolean
    For i = 1 To Len(str)
        If Unicode(Mid(str, i, 1)) >= 44032 Then
            If Unicode(Mid(str, i, 1)) <= 55203 Then
                hasDBCS = True
                Exit Function
            End If
        End If
    Next
    hasDBCS = False
End Function
看更多先前的回應...收起先前的回應...
ccenjor iT邦高手 1 級 ‧ 2022-02-17 21:14:12 檢舉

海大執行會出現如下圖訊息,好像UNICODE不能在VBA中使用。
https://ithelp.ithome.com.tw/upload/images/20220217/20109881g5tXXM8vMo.png

若改成是否可行
感謝測試

Function hasDBCS(ByVal str As String) As Boolean
    For i = 1 To Len(str)
        If Application.WorksheetFunction.Unicode(Mid(str, i, 1)) >= 44032 Then
            If Application.WorksheetFunction.Unicode(Mid(str, i, 1)) <= 55203 Then
                hasDBCS = True
                Exit Function
            End If
        End If
    Next
    hasDBCS = False
End Function
ccenjor iT邦高手 1 級 ‧ 2022-02-18 21:42:26 檢舉

海大OK了。

xyz321763 iT邦新手 5 級 ‧ 2022-03-10 16:57:05 檢舉

非常感謝你的幫忙:DD

3
ccenjor
iT邦高手 1 級 ‧ 2022-02-16 20:44:24

B1:
=IF(SUM(--(UNICODE(MID($A1,ROW(INDIRECT("1:"&LEN($A1))),1))>=44032)*--(UNICODE(MID($A1,ROW(INDIRECT("1:"&LEN($A1))),1))<=55203)),1,0)
按CTRL+SHIFT+ENTER鍵完成輸入,並複製到公式向下到B2:B4001。
框選A1:B4001。
再點取「常用 > 條件式格式設定 > 新增規則」。
https://ithelp.ithome.com.tw/upload/images/20220216/20109881LSiDsKtFrI.png

結果
https://ithelp.ithome.com.tw/upload/images/20220216/20109881DzJT7x0Ina.png

xyz321763 iT邦新手 5 級 ‧ 2022-02-17 14:42:41 檢舉

不好意思!我想要使用巨集的方式,不過還是很感謝您的留言!

0
blanksoul12
iT邦研究生 5 級 ‧ 2022-02-18 09:14:37
Sub test()

For i = 1 To [a1048576].End(xlUp).Row
    For j = 1 To Len(Cells(i, "a"))
        If WorksheetFunction.Unicode(Mid(Cells(i, "a"), j, 1)) >= 44032 And WorksheetFunction.Unicode(Mid(Cells(i, "a"), j, 1)) <= 55203 Then
            Cells(i, "a").Interior.ColorIndex = 6
            exit for
        Else
            Cells(i, "a").Interior.ColorIndex = xlNone
        End If
    Next
Next

End Sub
xyz321763 iT邦新手 5 級 ‧ 2022-03-10 17:02:37 檢舉

謝謝你
可以用,非常感謝!

我要發表回答

立即登入回答