无法在一张纸上运行2组代码
我需要VBA的帮助，因为我是这个编程语言的新手。 工作簿中的一张表中是否可以有两组不同的代码？
我想让Excel工作表更具交互性，比如点击某个单元格，然后突出显示该单元格被选中的整个行。 但即时通讯试图使它交互的表已经有一套代码。
这是我想让Excel工作表互动的代码
Private Sub Worksheet_SelectionChange(ByVal Target As Range) initializeWorksheets Dim ws As Worksheet For Each ws In Worksheets ws.Activate ' Clear the color of all the cells Cells.Interior.ColorIndex = 0 If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False With ActiveCell ' Highlight the row and column that contain the active cell, within the current region Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).Interior.ColorIndex = 6 End With Next ws Application.ScreenUpdating = True End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'filtering Dim ws As Worksheet ws.Activate Dim ccolumn As Integer Dim vvalue As String ccolumn = ActiveCell.Column vvalue = ActiveCell.Value For Each ws In Worksheets If IsEmpty(Target) Or Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False With ActiveCell Range(Cells(.Row, .CurrentRegion.Column), Cells(.Row, .CurrentRegion.Columns.Count + .CurrentRegion.Column - 1)).AutoFilter Field:=ccolumn, Criteria1:=vvalue Cancel = True End With Next ws End Sub
以下是用于相同工作表的代码：
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) initializeWorksheets Application.ScreenUpdating = False If (ActiveSheet.Name = "Student Viewer") Then searchKey = Trim(Target.Range.Value) If (Right(searchKey, 1) = ")") Then searchKey = Right(searchKey, Len(searchKey) - InStrRev(searchKey, "(", -1)) searchKey = Left(searchKey, Len(searchKey) - 1) End If temp = 2 Do While (mainSheet.Range(findColumn(mainSheet, "IC Number") & temp) <> searchKey & "") temp = temp + 1 If (temp > 65535) Then MsgBox ("Error in Finding xxxx Details") End End If Loop viewerSheet.Unprotect ' Set details For i = 2 To 10 viewerSheet.Range("C" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("B" & i), Len(viewerSheet.Range("B" & i)) - 1)) & temp) viewerSheet.Range("F" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("E" & i), Len(viewerSheet.Range("E" & i)) - 1)) & temp) Next i For i = 2 To 3 viewerSheet.Range("I" & i) = mainSheet.Range(findColumn(mainSheet, Left(viewerSheet.Range("H" & i), Len(viewerSheet.Range("H" & i)) - 1)) & temp) Next i loadSummary viewerSheet.Protect ElseIf (ActiveSheet.Name = "xxxx Viewer") Then searchKey = Trim(Target.Range.Value) viewerSheet2.Unprotect ' Set details temp = 2 Do While (DetailsSheet.Range(findColumn(DetailsSheet, "Policy Num") & temp) <> searchKey & "") temp = temp + 1 If (temp > 65535) Then MsgBox ("Error in Finding Details") End End If Loop For i = 2 To 11 viewerSheet2.Range("C" & i) = DetailsSheet.Range(findColumn(DetailsSheet, Left(viewerSheet2.Range("B" & i), Len(viewerSheet2.Range("B" & i)) - 1)) & temp) Next i For i = 2 To 6 viewerSheet2.Range("I" & i) = ValuesSheet.Range(findColumn(ValuesSheet, Left(viewerSheet2.Range("H" & i), Len(viewerSheet2.Range("H" & i)) - 1)) & temp) Next i For i = 7 To 12 viewerSheet2.Range("I" & i) = DetailsSheet.Range(findColumn(DetailsSheet, Left(viewerSheet2.Range("H" & i), Len(viewerSheet2.Range("H" & i)) - 1)) & temp) Next i viewerSheet2.Hyperlinks.Add Anchor:=Range("C2"), Address:="", SubAddress:="'Client Viewer'!A1" loadDetail viewerSheet2.Protect End If Application.ScreenUpdating = True End Sub
正如评论，你可以尝试这种方法：
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo halt Application.EnableEvents = False With Me ' Me refers to the worksheet where you put this code .Cells.Interior.ColorIndex = -4142 ' xlNone If Not CBool(-Target.Hyperlinks.Count) Then ' Check if there is hyperlink Target.EntireRow.Interior.ColorIndex = 6 ' or you can use RGB(255, 255, 0) Else Target.Hyperlinks(1).Follow ' follow hyperlink if there is CodeFromYourFollowHyperlinkEvent ' call a routine End If End With moveon: Application.EnableEvents = True Exit Sub halt: MsgBox Err.Description Resume moveon End Sub
正如你在上面看到的， CodeFromYourFollowHyperlinkEvent应该是一个包含你想要在你的FollowHyperlink事件中完成的子操作，如下所示。
Private Sub CodeFromYourFollowHyperlinkEvent() ' Put your code in FollowHyperlink here initializeWorksheets Application.ScreenUpdating = False If (ActiveSheet.Name = "Student Viewer") Then . . . End Sub
现在请注意，您需要明确地处理您的对象。
要了解更多信息， 请检查这个很酷的post 。