{"id":702,"date":"2025-04-12T17:27:43","date_gmt":"2025-04-12T09:27:43","guid":{"rendered":"http:\/\/www.x4s.cn\/?p=702"},"modified":"2025-04-12T17:28:58","modified_gmt":"2025-04-12T09:28:58","slug":"deepseek-r1%e7%bc%96%e5%86%99excel%e8%a1%a8%e6%a0%bc%e6%95%b0%e6%8d%ae%e5%8c%b9%e9%85%8dvba%e4%bb%a3%e7%a0%81","status":"publish","type":"post","link":"http:\/\/www.x4s.cn\/?p=702","title":{"rendered":"DeepSeek-R1\u7f16\u5199Excel\u8868\u683c\u6570\u636e\u5339\u914dVBA\u4ee3\u7801"},"content":{"rendered":"\n

VB\u4ee3\u7801 \u8981\u6c42\uff1aexcel\u8868\u4e00\u5f55\u5165\u6570\u636e\u5982\u679c\u8868\u4e8c\u4e0d\u5b58\u5728\u76f8\u540c\u503c\u5219\u8868\u4e00\u5f53\u524d\u5355\u5143\u683c\u5e95\u8272\u84dd\u8272\u5b57\u4f53\u767d\u8272\uff0c\u5982\u679c\u8868\u4e8c\u6709\u4e24\u4e2a\u4ee5\u4e0a\u76f8\u540c\u503c\u5219\u8868\u4e00\u5f53\u524d\u5355\u5143\u683c\u5e95\u8272\u7ea2\u8272\u5b57\u4f53\u52a0\u7c97\uff0c\u5982\u679c\u8868\u4e00\u5df2\u6709\u76f8\u540c\u503c\u5219\u5f53\u524d\u5355\u5143\u683c\u9ed1\u5e95\u767d\u5b57<\/p>\n\n\n\n

\u6839\u636e\u9700\u6c42\uff0c\u4ee5\u4e0b\u662f\u5b9e\u73b0\u200c\u8868\u4e8c\u6570\u636e\u6821\u9a8c<\/strong>\u200c\u7684VBA\u4ee3\u7801\uff0c\u5305\u542b\u667a\u80fd\u683c\u5f0f\u6807\u8bb0\u548c\u6027\u80fd\u4f18\u5316\uff1a<\/p>\n\n\n\n

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrorHandler
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim checkRange As Range, cell As Range
    Dim dictSheet2 As Object
    Dim valCheck As Variant
    
    ' \u57fa\u7840\u8bbe\u7f6e
    Set ws1 = Me  ' \u5f53\u524d\u5de5\u4f5c\u8868\uff08\u8868\u4e00\uff09
    Set ws2 = ThisWorkbook.Worksheets(\"Sheet2\")  ' \u4fee\u6539\u4e3a\u8868\u4e8c\u5b9e\u9645\u540d\u79f0
    Set checkRange = ws2.Range(\"A:A\")           ' \u8868\u4e8c\u68c0\u67e5\u5217\uff08\u6309\u9700\u4fee\u6539\uff09
    
    ' \u521b\u5efa\u5b57\u5178\u7edf\u8ba1\u8868\u4e8c\u6570\u636e
    Set dictSheet2 = CreateObject(\"Scripting.Dictionary\")
    For Each cell In checkRange
        If Not IsEmpty(cell.Value) Then
            valCheck = cell.Value
            dictSheet2(valCheck) = dictSheet2(valCheck) + 1
        End If
    Next
    
    ' \u52a8\u6001\u683c\u5f0f\u8bbe\u7f6e
    For Each cell In Target
        If Not IsEmpty(cell.Value) Then
            valCheck = cell.Value
            
            ' \u6e05\u9664\u65e7\u683c\u5f0f
            With cell
                .Interior.Color = xlNone
                .Font.Color = vbBlack
                .Font.Bold = False
            End With
            
            ' \u8868\u4e8c\u6821\u9a8c\u903b\u8f91
            Select Case True
                Case Not dictSheet2.Exists(valCheck)  ' \u8868\u4e8c\u65e0\u91cd\u590d
                    cell.Interior.Color = RGB(0, 0, 255)  ' \u84dd\u5e95
                    cell.Font.Color = RGB(255, 255, 255) ' \u767d\u5b57
                Case dictSheet2(valCheck) >= 2          ' \u8868\u4e8c2+\u91cd\u590d
                    cell.Interior.Color = RGB(255, 0, 0)  ' \u7ea2\u5e95
                    cell.Font.Bold = True
            End Select
        Else
            cell.Interior.Color = xlNone
            cell.Font.Color = vbBlack
            cell.Font.Bold = False
        End If
    Next

ExitHandler:
    Set dictSheet2 = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
    
ErrorHandler:
    MsgBox \"\u9519\u8bef \" & Err.Number & \": \" & Err.Description, vbCritical
    Resume ExitHandler
End Sub
<\/code><\/pre>\n\n\n\n
\n\n\n\n
\u200c\u6838\u5fc3\u903b\u8f91\u8bf4\u660e<\/strong>\u200c<\/h3>\n\n\n\n
\u6761\u4ef6<\/th>\u683c\u5f0f\u6548\u679c<\/th>\u5b9e\u73b0\u65b9\u6cd5<\/th><\/tr><\/thead>
\u8868\u4e8c\u65e0\u76f8\u540c\u503c<\/td>\u84dd\u8272\u80cc\u666f + \u767d\u8272\u5b57\u4f53<\/td>\u901a\u8fc7\u5b57\u5178\u5feb\u901f\u68c0\u6d4b\u6570\u503c\u662f\u5426\u5b58\u5728<\/td><\/tr>
\u8868\u4e8c\u5b58\u57282+\u76f8\u540c\u503c<\/td>\u7ea2\u8272\u80cc\u666f + \u52a0\u7c97\u5b57\u4f53<\/td>\u4f7f\u7528Case<\/code>\u8bed\u53e5\u8fdb\u884c\u6b21\u6570\u5224\u65ad<\/td><\/tr>
\u8868\u4e8c\u5b58\u57281\u4e2a\u76f8\u540c\u503c<\/td>\u4fdd\u6301\u9ed8\u8ba4\u683c\u5f0f<\/td>\u4e0d\u6ee1\u8db3\u524d\u4e24\u4e2a\u6761\u4ef6\u65f6\u81ea\u52a8\u8df3\u8fc7<\/td><\/tr><\/tbody><\/table><\/figure>\n\n\n\n
\n\n\n\n
\u200c\u4f7f\u7528\u8bf4\u660e<\/strong>\u200c<\/h3>\n\n\n\n
    \n
  1. \u200c\u53c2\u6570\u914d\u7f6e<\/strong>\u200c\uff1a vbaCopy CodeSet ws2 = ThisWorkbook.Worksheets(\"Sheet2\") ' \u4fee\u6539\u4e3a\u5b9e\u9645\u8868\u4e8c\u540d\u79f0 Set checkRange = ws2.Range(\"A:A\") ' \u4fee\u6539\u4e3a\u8868\u4e8c\u5b9e\u9645\u68c0\u67e5\u5217<\/code><\/li>\n\n\n\n
  2. \u200c\u6548\u679c\u9a8c\u8bc1<\/strong>\u200c\uff1a markdownCopy Code| \u64cd\u4f5c | \u8868\u4e00\u6548\u679c | \u8868\u4e8c\u72b6\u6001\u793a\u4f8b | |----------------------|------------------------------|--------------------| | \u8f93\u5165\"Apple\" | \u84dd\u5e95\u767d\u5b57 | \u8868\u4e8c\u65e0Apple | | \u8f93\u5165\"Orange\" | \u7ea2\u5e95\u52a0\u7c97 | \u8868\u4e8c\u67093\u4e2aOrange | | \u8f93\u5165\"Banana\" | \u4fdd\u6301\u9ed8\u8ba4 | \u8868\u4e8c\u67091\u4e2aBanana | | \u5220\u9664\u5355\u5143\u683c\u5185\u5bb9 | \u81ea\u52a8\u6e05\u9664\u683c\u5f0f | - |<\/code><\/li>\n\n\n\n
  3. \u200c\u6027\u80fd\u4f18\u5316<\/strong>\u200c\uff1a\n