如何遍歷列表，遵循超鏈接並刪除相應的工作表

我有一個包含大約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

如何遍歷列表，遵循超鏈接並刪除相應的工作表

回答

相關問題