Question

方案：

除了Sheet2列C-E中的“some content”和包含Worksheet_SelectionChange处理程序的Sheet1之外，我有两个相同的工作表

当我单击Sheet1中的B列时，Worksheet_SelectionChange会更改单元格颜色，然后将C-E列设置为Sheet2 C列的C-E

问题：

麻烦在于应用程序错误......

任何人都可以帮忙，这真的很烦人......我如何在Sheetheet_SelectionChange处理程序中将数据从Sheet2复制到Sheet 1？

如果我设置S1C =“X”（如在硬编码中那样很好），当我尝试从第二张纸中引用它不起作用的单元格时。

非常感谢，提前，最好的问候

代码如下：

Public benRel
Public rskOpt
Public resOpt
Public getRow
Public getCol

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo ExitSubCorrectly
'turn off multiple recurring changes
Application.EnableEvents = False

'do not allow range selection
If Target.Cells.Count > 1 Then GoTo ExitSubCorrectly


'only allow selection within our range
Set myRange = Range("B8:B24")
If Not Application.Intersect(Target, myRange) Is Nothing Then
    ' At least one cell of Target is within the range myRange.
    ' Carry out some action.

    getRow = Target.Row
    getCol = Target.Column


    Select Case Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style

        Case "Normal"
            Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style = "Accent1"

            getData
            putData

        Case "Accent1"
            Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Style = "Normal"
            Range(Cells(Target.Row, Target.Column + 1), Cells(Target.Row, Target.Column + 3)).Value = ""

        Case Else

    End Select

Else
    ' No cell of Target in in the range. Get Out.
    GoTo ExitSubCorrectly
End If

ExitSubCorrectly:
' go back and turn on changes
' MsgBox Err.Description
Worksheets("Sheet1").Select
Application.EnableEvents = True

End Sub

Sub getData()

Worksheets("Sheet2").Select
Range(Cells(getRow, getCol), Cells(getRow, getCol)).Select
benRel = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 1).Value
rskOpt = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 2).Value
resOpt = Range(Cells(getRow, getCol), Cells(getRow, getCol)).Offset(0, 3).Value


End Sub

Sub putData()

Worksheets("Sheet1").Select
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 1).Value = benRel
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 2).Value = rskOpt
Range(Cells(Target.Row, Target.Column), Cells(Target.Row, Target.Column)).Offset(0, 3).Value = resOpt

End Sub

Answer 1

在我看来，你可以用

替换所有三个例程

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   On Error GoTo ExitSubCorrectly
   'turn off multiple recurring changes
   Application.EnableEvents = False

   'do not allow range selection
   If Target.Cells.Count > 1 Then GoTo ExitSubCorrectly

   'only allow selection within our range
   Set myRange = Range("B8:B24")
   If Not Application.Intersect(Target, myRange) Is Nothing Then
      ' At least one cell of Target is within the range myRange.
      ' Carry out some action.
      With Cells(Target.Row, Target.Column)
         Select Case .Style

            Case "Normal"
               .Style = "Accent1"
               .Offset(0, 1).Resize(, 3).Value = Worksheets("Sheet2").Cells(getRow, getCol).Offset(0, 1).Resize(, 3).Value
            Case "Accent1"
               .Style = "Normal"
               .Offset(0, 1).Resize(, 3).ClearContents
            Case Else

         End Select
      End With

   End If

ExitSubCorrectly:
   ' go back and turn on changes
   ' MsgBox Err.Description
   Application.EnableEvents = True

End Sub

excel Worksheet_SelectionChange - 复制数据

1 个答案: