循環 A 列中的所有值以查找 B 列中的所有匹配項

Question

我的代碼在外部工作簿中找到所有內部連接，找到所有隱藏的工作表。

由於該值，我想實現的是刪除所有隱藏的工作表，這些工作表不是工作簿中任何其他工作表的來源。

我知道它應該用嵌套循環來完成，但我在構建它時遇到了問題。

For Each c In wbmacro.Sheets("Link Sheet").Range("D2:D10")
    For Each rc In wbmacro.Sheets("Link Sheet").Range("C2:C10")
        If c.Value <> rc.Value Then
            wbtarget.Sheets(c).Delete
        End If
    Next
Next

我測試了所有三個響應，代碼運行中沒有任何反應。

完整的代碼審查：

Sub a()

Dim xSheet As Worksheet
Dim xRg As Range
Dim xCell As Range
Dim xCount As Long
Dim xLinkArr() As String
Dim wbmacro As Workbook
Dim wbtarget As Workbook
Dim strfile As String
Dim strpath As String
Dim filename As String
Dim hsheet As String

Set wbmacro = ActiveWorkbook
filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx")

Set wbtarget = Workbooks.Open(filename, UpdateLinks:=0)
        
On Error Resume Next

For Each xSheet In wbtarget.Sheets
    
    Set xRg = xSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
    If xRg Is Nothing Then GoTo LblNext
    For Each xCell In xRg
        If InStr(1, xCell.Formula, "!") > 0 Then
            xCount = xCount + 1
            ReDim Preserve xLinkArr(1 To 2, 1 To xCount)
            xLinkArr(1, xCount) = xCell.Address(, , , True)
            xLinkArr(2, xCount) = "'" & xCell.Formula
       End If
    Next

LblNext:
Next

If xCount > 0 Then
    wbmacro.Activate
    wbmacro.Sheets("Link Sheet").Activate
    Range("A1").Resize(, 3).Value = Array("Location", "Reference", "Reference Sheet Name")
    Range("A2").Resize(UBound(xLinkArr, 2), UBound(xLinkArr, 1)).Value = Application.Transpose(xLinkArr)
    Columns("A:D").AutoFit
Else
    MsgBox "No links were found within the active workbook.", vbInformation
End If

x = 2
For Each ws In wbtarget.Worksheets
    If ws.Visible = xlSheetHidden Then
        wbmacro.Sheets("Link Sheet").Cells(x, 4) = ws.Name
        x = x + 1
    End If
Next ws

wbmacro.Activate
Columns("A:C").Select
ActiveSheet.Range("$A$1:$B$758").RemoveDuplicates Columns:=1, Header:=xlNo

Dim rc As Range
For Each c In wbmacro.Sheets("Link Sheet").Range("D2:D10").Cells
    ' The default behaviour is to delete the sheet
    bDeleteSheet = True
    For Each rc In wbmacro.Sheets("Link Sheet").Range("C2:C10").Cells
        If c.Value = rc.Value Then
            ' If you find the sheet name then it is used
            ' Do NOT delete it
            bDeleteSheet = False
            Exit For
        End If
    Next
    If bDeleteSheet Then wbtarget.Sheets(c).Delete
Next

End Sub

Answer 1

循環一次並使用Application.Match()查看它是否存在：

For Each c In wbmacro.Sheets("Link Sheet").Range("D2:D10")
    If IsError(Application.Match(c,wbmacro.Sheets("Link Sheet").Range("C2:C10"),0)) and Len(c) > 0 then
        wbtarget.Sheets(c).Delete
    End If
Next

Answer 2

嘗試這樣的事情

Dim bDeleteSheet As Boolean

For Each c In wbmacro.Sheets("Link Sheet").Range("D2:D10").Cells
    ' The default behaviour is to delete the sheet
    bDeleteSheet = True
    For Each rc In wbmacro.Sheets("Link Sheet").Range("C2:C10").Cells
        If c.Value = rc.Value Then
            ' If you find the sheet name then it is used
            ' Do NOT delete it
            bDeleteSheet = False
            Exit For
        End If
    Next
    If bDeleteSheet Then wbtarget.Sheets(c).Delete
Next

編輯：我在兩行中添加了.Cells ：根據我的經驗，省略這在過去給我帶來了一些問題。

我還必須提到，這不是迄今為止最有效或最動態的代碼，但它遵循您的邏輯，這是一個很好的起點。

實際上，在像這樣的小代碼中，任何優化都不會對代碼的執行時間產生很小的影響。 但是，隨着您的代碼增長和/或您在更多單元格中循環，有一些方法可以優化您的代碼。

• 為了使您的代碼更高效，一般的經驗法則是盡量減少與 excel 應用程序的任何交互，並實現您的谷歌主題，例如“如何在 vba 中讀取 memory 中的我的范圍”

• 為了使您的代碼更加動態的谷歌主題，例如“如何在 excel vba 中更動態地引用范圍”。 例如，您可以像這樣計算，而不是硬編碼范圍內的第10行：

Dim lLastRow as Long
lLastRow = wbmacro.Sheets("Link Sheet").Range("C" & Columns.Count).End(xlUp).Row

這與一直向下到 C 列中的最后一個單元格並按 Ctrl+Up 相同，這將帶您到該列中最后使用的單元格，然后讀取行號。

現在您可以像這樣引用范圍：

wbmacro.Sheets("Link Sheet").Range("C2:C" & lLastRow)

請注意（從上圖中） lLastRow現在的值為 3，這意味着您的代碼不會不必要地再循環 7 次。

Answer 3

Scott & dwirony 擊敗了我，但我在他們發布的時候到了那里，這是我想出的代碼：

Sub Test()

Dim Ref As Range
  
For Each Ref In Range("HiddenSheets").Cells
 
   With Application
        On Error Resume Next
        Err.Clear
        Result = .WorksheetFunction.Match(Ref.Value, Range("References"), 0)
        If Err.Number > 0 Then
            .DisplayAlerts = False
           MsgBox "Deleting: " & Ref.Value, vbOKOnly, _
                  "Delete: Confirmation"
           ' wbtarget.Sheets(Ref.Value).Delete
            .DisplayAlerts = True
        End If
        
   End With
   
Next Ref

End Sub 'Test

注意：我設置了兩個動態命名引用，因此列 C：名稱“引用”或列 D：名稱“HiddenSheets”中有多少項目並不重要我還注釋掉了刪除語句並使用消息框來檢查發生了什么。 請注意 DisplayAlerts 的使用，這樣您就不會單擊刪除對話框。 您還必須重新添加完全合格的參考，以便工作簿從中刪除工作表。

HTH

Answer 4

我認為它現在完美無缺。 我混合了你的代碼：

Sub b()
Dim c As Range
Dim filename As String
Dim lLastRow1 As Long
Dim lLastRow2 As Long

Set wbmacro = ActiveWorkbook
filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xlsx")
Set wbtarget = Workbooks.Open(filename, UpdateLinks:=0)
lLastRow1 = wbmacro.Sheets("Link Sheet").Range("C" & Columns.Count).End(xlUp).row
lLastRow2 = wbmacro.Sheets("Link Sheet").Range("D" & Columns.Count).End(xlUp).row
Dim Ref As Range
wbmacro.Activate

For Each Ref In wbmacro.Sheets("Link Sheet").Range("D2:D" & lLastRow2).Cells

With Application
    On Error Resume Next
    Err.Clear
    result = .WorksheetFunction.Match(Ref.Value, Range("C2:C" & lLastRow1), 0)
    If Err.Number > 0 Then
        .DisplayAlerts = False
       MsgBox "Deleting: " & Ref.Value, vbOKOnly, _
              "Delete: Confirmation"
        wbtarget.Sheets(Ref.Value).Delete
        .DisplayAlerts = True
    End If
    
 End With

  Next Ref


 End Sub