如何根据单元格选择复制行的固定部分,Excel vba?

如何根据单元格选择复制行的固定部分,Excel vba?,excel,vba,Excel,Vba,我有很多列的表格,如果我选择单元格B3或C3(例如),我需要在同一行上复制单元格B3:G3 选择可以是图纸上的任何行。是否可以用vba完成? 样本表附在此链接上 选择行范围 当选择包含列B和/或C中的单元格的区域时,它将选择它们的行,但选择列B:G 它不包括包含合并单元格的前两行 它将允许多个非连续选择 图纸模块,例如图纸1 Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range)

我有很多列的表格,如果我选择单元格B3或C3(例如),我需要在同一行上复制单元格B3:G3

选择可以是图纸上的任何行。是否可以用vba完成? 样本表附在此链接上

选择行范围
  • 当选择包含列
    B
    和/或
    C
    中的单元格的区域时,它将选择它们的行,但选择列
    B:G
  • 它不包括包含合并单元格的前两行
  • 它将允许多个非连续选择
图纸模块,例如
图纸1

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Const cFirstRow As String = "B3:C3"
    Const sCols As String = "B:G"
    
    Dim crg As Range
    With Range(cFirstRow)
        Set crg = .Resize(Rows.Count - .Row + 1)
    End With
    
    Dim irg As Range: Set irg = Intersect(crg, Target)
    
    If Not irg Is Nothing Then
    
        Dim srg As Range, arg As Range, rrg As Range
        For Each arg In irg.Areas
            For Each rrg In arg.Rows
                If srg Is Nothing Then
                    Set srg = Columns(sCols).Rows(rrg.Row)
                Else
                    Set srg = Union(srg, Columns(sCols).Rows(rrg.Row))
                End If
            Next rrg
        Next arg
        
        If Not srg Is Nothing Then
            srg.Select
        End If
    
    End If
        
End Sub

它工作得很好。如果需要复制,只需修改srg.select。进入seg.copy。非常感谢