【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

三、效果图