如何遍历列表，遵循超链接并删除相应的工作表

我有一个包含大约150个工作表的工作簿。第一张工作表是大约150行，16列宽的信息表/列表，名为“日志”。在第“日志”工作表中的'j'是包含新的或关闭的单元格值。在第'm'是超链接到工作簿中的其他工作表。代码的目标是遍历“日志”表的每一行，并确定它是否包含在列中关闭。学家如果是，请按照相应的超链接，在同一行中删除工作表。问题是我有超链接被多行共享的情况。例如，第5行超链接到表2和第15行超链接到表2.我的问题是，当代码到达第15行并跟随超链接时，没有什么可遵循的，因此，“日志”是活动表并且“日志”最终被删除，然后我的代码被炸毁。有没有一种方法可以编写代码，说明如果活动工作表是日志工作表，而不是删除它或跳过当前就地删除工作表的代码，而是继续循环？如何遍历列表，遵循超链接并删除相应的工作表

这里是代码...

Sub Deletelinks() 

'Macro will check to see if status is closed and if so it will 
'delete the supporting worksheet by following the hyperlink in 
'same row 

Dim count As Integer 
Dim lrow As Long 
Dim Rng As Range 
Set Rng = Range("J2") 
lrow = Worksheets("log").Range("J" & Rows.count).End(xlUp).row - 1 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

For count = 1 To lrow 
    Sheets("log").Activate 
    Rng.Offset(count - 1, 0).Activate 
    Select Case ActiveCell.Value = "Closed" 
     Case True 
      If ActiveCell.Offset(0, 3).Value = "Click" Then 
      ActiveCell.Offset(0, 3).Hyperlinks(1).Follow 
       If ActiveSheet.Name <> "log" Then 
        With ActiveSheet 
         ActiveWindow.SelectedSheets.delete 
        End With 
       End If 
      End If 
     Case False 
    End Select 
Next count 


Application.DisplayAlerts = True 
Application.ScreenUpdating = True 


End Sub

来源

2016-11-02 Brian

我原以为你的行说'如果ActiveSheet.Name <>“log”Then'已经停止名为“log”的表被删除。它实际上是否被命名为“日志”？或者它可能被称为“日志”？ – YowE3K

如果第2行和第15行都有超链接到Sheet2，并且第2行显示“已关闭”，但第15行显示“已打开”，您是否希望Sheet2被删除或保留？（或者这将是一个非问题，因为这两行应该具有相同的状态？） – YowE3K

'如果ActiveSheet.name <>“日志”然后“我的代码的一部分似乎永远不会工作。我认为它会，但基本上被忽略了。我不确定它为什么不起作用，但那是为什么我问这个问题。要回答你的其他问题，它应该是一个非问题，因为他们应该是相同的。托马斯的代码看起来像他说的一个简单的方法，工作得很好。谢谢 – Brian

一个简单的方法是遍历该列中的超链接，并使用超链接的属性以引用相邻的单元格，看它是否等于Closed;那么如果是这样，请删除超链接目标工作表并清除超链接。

Sub DeleteLinks() 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 

    Dim link As Hyperlink 
    For Each link In Worksheets("log").Columns("M").Hyperlinks 

     If link.Range.Offset(0, -3) = "Closed" Then 
      On Error Resume Next 
      Range(link.SubAddress).Parent.Delete 
      On Error GoTo 0 
      link.Range.ClearContents 
     End If 

    Next 

    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
End Sub

来源

2016-11-02 02:31:21

谢谢托马斯。这更简单，并且正是我所需要的。 – Brian

如何遍历列表，遵循超链接并删除相应的工作表

回答

相关问题