Question

我的VBA代码有问题。问题是我有重复的名称 - 主要表格“经理”和表格的名称。

代码应该转到每个工作表并查找值“Engagements ID”，然后关闭一个单元格。在每张工作表中，Engagements ID的数量不同，因此代码应搜索每个工作表（500行） - 查找值“Engagements ID”然后将单元格下方的一行复制并粘贴到我的主工作表中，这是被称为“经理”。

谢谢你的帮助!! :)我想要的值是B列中的每张纸。

这是我的代码：

Option Explicit

Sub Check_Account()



Dim rng As Range
Dim xName As String
Dim i, j As Integer



For i = 3 To 6
xName = Cells(i, 1)
    If xName = "" Then Exit Sub
    On Error Resume Next
    ActiveWorkbook.Sheets(xName).Select
    Sheets(xName).Select

            For j = 1 To 500
                If rng.Cells(j, 2) = "Engagements ID" Then
                    rng.Offset(1, 0).Select
                    Selection.Copy
                    Sheets("Manager").Select

                        If Range("B" & i) = "" Then
                            Range("B" & i).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, 
                            Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            ActiveWorkbook.Sheets(xName).Select
                            Sheets(xName).Select
                            Cells(j, 2).Offset(1, 0).Select
                        Else
                            Range("B" & i).Offset(1, 0).Select
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                            ActiveWorkbook.Sheets(xName).Select
                            Sheets(xName).Select
                            Cells(j, 2).Offset(1, 0).Select
                        End If
                End If
            Next j
    On Error GoTo 0
Next i

End Sub

Answer 1

请尝试此代码。我想你会喜欢它。

Option Explicit

Sub Check_Account()
    ' 24 Nov 2017

    Dim TabName As String
    Dim Rng As Range
    Dim Fnd As Range
    Dim Rl As Long                              ' last row
    Dim FirstFnd As Long
    Dim i As Integer

    For i = 3 To 6
        ' Tab names are found at Manager!A3:A6
        TabName = Worksheets("Manager").Cells(i, "A").Value
        If Len(TabName) = 0 Then Exit For

        On Error Resume Next
        With Worksheets(TabName)
            If Err Then
                MsgBox "Worksheet """ & TabName & """ doesn't exist.", _
                       vbInformation, "Missing Worksheet"
            Else
                Rl = .Cells(.Rows.Count, "B").End(xlUp).Row
                Set Rng = Range(.Cells(1, "B"), .Cells(Rl, "B"))
                Set Fnd = Rng.Find("Engagements ID", _
                                   After:=Rng.Cells(Rng.Cells.Count), _
                                   LookIn:=xlValues, _
                                   LookAt:=xlPart, _
                                   SearchOrder:=xlByColumns, _
                                   SearchDirection:=xlNext, _
                                   MatchCase:=False, _
                                   MatchByte:=False)
                If Not Fnd Is Nothing Then
                    FirstFnd = Fnd.Row
                    Do
                        With Worksheets("Manager")
                            Rl = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                            ' start writing in row 2
                            If Rl < 2 Then Rl = 2
                            .Cells(Rl, "B").Value = Fnd.Offset(1).Value
                        End With
                        Set Fnd = Rng.FindNext(Fnd)
                    Loop While Not Fnd Is Nothing And Fnd.Row <> FirstFnd
                End If
            End If
        End With
    Next i
End Sub

Answer 2

我已经尝试并测试了下面的代码，我相信它符合您的预期：

   Sub foo()
    For i = 3 To 6
        xName = Sheets("Manager").Cells(i, 1).Value
        LastRow = Sheets(xName).Cells(Sheets(xName).Rows.Count, "B").End(xlUp).Row
        For x = 1 To LastRow
            If Sheets(xName).Cells(x, 2).Value = "Engagements ID" Then
                Sheets("Manager").Cells(i, 2).Value = Sheets(xName).Cells(x + 1, 2).Value
            End If
        Next x
    Next i
    End Sub

这对可能的错误没有任何验证，如果经理表不存在，那么你会收到错误......但至少代码更简洁，它指向正确的方向。

VBA：寻找值并将值复制并粘贴到其他工作表中

2 个答案: