Question

大家好，

我一直试图在这里找到适合我的问题的答案，但是我一直没有成功。我正在使用FIND在F列中搜索具有#N/A值的单元格，并将相邻的单元格复制到A列末尾的另一个“ Sheet2”中。循环查找下一个具有#N/A值的下一个单元，直到找到全部。

Sub Find()
    Dim SerchRange As Range
    Dim FindCell As Range
    Set SerchRange = Range("F:F")
    Set FindCell = SerchRange.FIND(What:="#N/A", _
      LookIn:=xlValues, _
      LookAt:=xlWhole, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, _
      MatchCase:=False)

    If FindCell Is Nothing Then
        MsgBox "Nothing was found all clear"    
    Else
        FindCell.Select
        ActiveCell.Offset(0, -3).Resize(, 3).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    End If
End Sub

Answer 1

尝试一下，让我知道它是否有效：

Option Explicit
Sub Find()
Application.ScreenUpdating = False
Dim SearchRange As Range
Dim FindCell As Range
Dim Check As Boolean
Dim LastRow As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim FindCounter As Long

Set ws = ThisWorkbook.Worksheets("Sheet1") ' <--- Insert the name of your worksheet here
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
LastRow = ws.Cells(Rows.Count, "F").End(xlUp).Row ' <--- Finds the last used row
Set SearchRange = Range("F1:F" & LastRow)
FindCounter = 0

For Each FindCell In SearchRange
    If FindCell.Value = "#N/A" Then
        FindCounter = FindCounter + 1
        FindCell.Offset(0, -3).Resize(, 3).Copy
        ws2.Range("A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteValues
    End If
Next

MsgBox "Succes!" & vbNewLine & vbNewLine & "This many cells were found: " & FindCounter
Application.ScreenUpdating = True
End Sub

VBA查找＃N / A值并将相邻的单元格复制到另一个工作表并循环

1 个答案: