【vba】Excel選中單元格時自動標識對應的行和列

　　我們在分析識別數據量（行和列）比較多的工作表時，肉眼無法准確的識別一整行或一整列。

　　本文旨在通過工作表或工作簿的SelectionChange事件，當選擇單元格時會自動標志其對應的整行和整理（如果選中的是多個單元格，則以左上角第一個單元格為准）

　　本文分為工作表事件Worksheet_SelectionChange和工作簿Workbook_SheetSelectionChange事件，即事件的生效范圍是單個工作表還是整個工作簿。

　　兩類事件的操作區別是分別將代碼copy到對應的工作表，還是ThisWorkbook中。

　　 

一、准備工作

　　Excel文檔的安全性說明，2003版本.xls的文檔可以直接保存vba代碼，2007以上的.xlsx文檔不能保存vba代碼，.xlsx存放數據，.xlsm是可以同時存放代碼和數據

1、所以，首先要將.xlsx文檔通過另存為保存為“Excel啟用宏的工作簿(*.xlsm)”

　　 

2、其次，要對代碼內容進行微調（代碼中紅色字體部分）

• 設置代碼適用於工作表的起始行和列

　　iniCol = 1 ---代碼操作的開始列（這里不做排除，直接從第1列開始）
　　iniRow = 3 ---代碼操作的開始行（可以排除標題等行，這里排除標題后，從第3行開始）

• 設置單元格區域的最大行號和列號

　　這里邏輯是以“A1”為基准與之相關的連的連續區域，根據工作表情況替換“A1”（“A1”必須是目標區域內的單元格之一）
　　xrow = Range("A1").CurrentRegion.Rows.Count
　　xcol = Range("A1").CurrentRegion.Columns.Count

• 選擇單元格時，設置對應單元和所在的整行和整列的背景色　

　　Range(Cells(Target.Row, iniCol), Cells(Target.Row, xcol)).Interior.ColorIndex = 20 '添加底紋顏色，行　　
　　Range(Cells(iniRow, Target.Column), Cells(xrow, Target.Column)).Interior.ColorIndex = 20　'添加底紋顏色，列　

　　背景色序號ColorIndex 與顏色的對應關系

　　

3、最后，將校准和修改后的宏工作簿.xlsm通過另存為.xlsx文檔保存（宏工作簿.xlsm的數據和格式會保存下來，但是宏代碼會被刪除掉）

  

二、代碼

1、工作表的事件

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
    Dim iniCol, iniRow '起始行列
    iniCol = 1
    iniRow = 3
    
    '判斷表格當前區域行數和列數
    Dim xrow, xcol
 xrow = Range("A1").CurrentRegion.Rows.Count
    xcol = Range("A1").CurrentRegion.Columns.Count
    
    '當選中的單元格個數大於1時，重新給Target賦值
    If Target.Count > 1 Then
        Set Target = Target.Cells(1)
    End If
    
    '當選中的單元格不包含指定區域的單元格時，退出程序,Intersect方法返回參數指定的多個單元格的公共區域。參數至少是兩個Range對象
    If Application.Intersect(Target, Range(Cells(iniRow, iniCol), Cells(xrow, xcol))) Is Nothing Then
        '清除單元格里原有底紋顏色
        Range(Cells(iniRow, iniCol), Cells(xrow, xcol)).Interior.ColorIndex = xlNone
        Exit Sub
    End If
    
    '清除單元格里原有底紋顏色
    Range(Cells(iniRow, iniCol), Cells(xrow, xcol)).Interior.ColorIndex = xlNone
    
    '添加底紋顏色，行
    Range(Cells(Target.Row, iniCol), Cells(Target.Row, xcol)).Interior.ColorIndex = 20
    '添加底紋顏色，列
    Range(Cells(iniRow, Target.Column), Cells(xrow, Target.Column)).Interior.ColorIndex = 20
End Sub

2、工作簿的事件

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next  '跳過異常
    
    '排除特定工作表，指定工作表不作處理 WorksheetFunction.Match(Sh.Name, Array("轉置", "工資條", "商品名稱"))
    If Sh.Name = "轉置" Or Sh.Name = "工資條" Or Sh.Name = "商品名稱" Then
        Exit Sub
    End If
    
    Dim iniCol, iniRow '起始行列
    iniCol = 1
    iniRow = 3
    
    '判斷表格當前區域行數和列數
    Dim xrow, xcol
 xrow = Range("A1").CurrentRegion.Rows.Count
    xcol = Range("A1").CurrentRegion.Columns.Count
    
    '當選中的單元格個數大於1時，重新給Target賦值
    If Target.Count > 1 Then
        Set Target = Target.Cells(1)
    End If
    
    '當選中的單元格不包含指定區域的單元格時，退出程序,Intersect方法返回參數指定的多個單元格的公共區域。參數至少是兩個Range對象
    If Application.Intersect(Target, Range(Cells(iniRow, iniCol), Cells(xrow, xcol))) Is Nothing Then
        '清除單元格里原有底紋顏色
        Range(Cells(iniRow, iniCol), Cells(xrow, xcol)).Interior.ColorIndex = xlNone
        Exit Sub
    End If
    
    '清除單元格里原有底紋顏色
    Range(Cells(iniRow, iniCol), Cells(xrow, xcol)).Interior.ColorIndex = xlNone
    
    '添加底紋顏色，行
    Range(Cells(Target.row, iniCol), Cells(Target.row, xcol)).Interior.ColorIndex = 20
    '添加底紋顏色，列
    Range(Cells(iniRow, Target.Column), Cells(xrow, Target.Column)).Interior.ColorIndex = 20
End Sub

三、效果圖