循环查找匹配搜索条件的记录，然后在两个电子表格之间剪切和粘贴

Question

我是 VBA 的新手，一直在网上搜索和观看 YouTube 教程，但在编写下面的代码并使其运行时遇到了问题。我在同一个 workbook.Any 帮助中使用两个 spreadsheets 将不胜感激。请理解我是初学者，需要一些指导。没有必要贬低评论。我已经为此工作了两个多星期，就是想不通。

我有一个 sheet 标记为“模板”，单元格 A1 中有一个学生姓名。学生的姓名会更改，但姓名的位置将始终在此单元格中。

在我的第二个跨页sheet 中标记为“评估”，我需要运行在 A 列中循环以查找学生姓名。

如果在该搜索过程中找到了学生姓名，那么我需要复制 AC 列中与找到该姓名的行对应的所有信息。

复制的任何内容都需要粘贴到我的第一个跨页sheet A 列第 61-70 行的“模板”中，并使其自动添加适合复制行所需的任何其他行。

Option Explicit

Sub Test()
Dim StudentName As String '(StudentName is a unique identifier)
Dim Template As Worksheet '(this is the worksheet I'm pulling data into)
Dim Evaluations As Worksheet '(this is the sheet I'm pulling data from)
Dim finalrow As Integer
Dim i As Integer
Set Template = Sheets("Evaluation Form Template")
Set Evaluations = Sheets("Evaluations")

'this is where i want to cut and paste to
'getting an error here
 Range("A61:A70").ClearContents

'This is the value I am looking for: getting an error here
 StudentName = Sheets("Template").Range("A1").Value

 'this is the sheet I am searching my value in Column A
 finalrow = Sheets("Evaluations").Range("A10000").End(xlUp).Row

 'once it runs the loop if the student name was found in Column A then I   need it to copy and paste any information in Column 29/AC
'into my Template sheet in Column A row 61
 For i = 2 To finalrow
 If Cells(i, 1) = StudentName Then
 Range(Cells(i, 29)).Copy
 Sheets("template").Range("A61").End(xldown).Offset(1, 0).PasteSpecialxlPasteFormulasAndNumberFormats
 End If
 Next i

 End Sub

Answer 1

我发现有几件事可能是个问题。您正在为 worksheet 设置一些变量，但您没有使用它们。例如，您是否尝试像这样清除模板 sheet 中的内容：

Template.Range("A61:A70").ClearContents

你可以这样获取学生姓名：

StudentName = Template.Range("A1").Value
'or shorter version
StudentName = Template.[A1]

在你的 sheet 循环中你正在循环：

If Evaluations.Cells(i,1) = StudentName then

最后，您不必复制，您可以将一个值设置为与另一个值相等以填充单元格，如下所示：

Template.Range("A61").End(xldown).Offset(1,0) = Evaluations.Range(Cells(i,1),Cells(i,29))

这样做的好处是确保您完全符合获取信息的地点和发送信息的地点。最后一件事，我不确定这是否意味着这样，但您使用 Evaluation Form Template 作为 Template 的工作 sheet 但使用名称 Template作为其他地方的参考。它们应该相同吗？

Answer 2

1) 您已经声明了您的 sheets 但您没有使用它。

Set Template = ThisWorkbook.Sheets("Evaluation Form Template")
Set Evaluations = ThisWorkbook.Sheets("Evaluations")

然后写- Template.Range("A1").Value
而不是 - Sheets("Template").Range("A1").Value

我认为您出错是因为您没有指定 sheet:

写 - Template.Range("A61:A70").ClearContents
而不是 - Range("A61:A70").ClearContents

2) 如果学生的名字是唯一的，你应该使用Range.Find方法而不是在所有行上循环。会快很多。

Returns a Range object that represents the first cell where that information is found. https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-find-method-excel

Dim name_rg As range

{...}

' ~ Search name of the student ~
Set name_rg = Evaluation.columns(1).Find(Template.[a1])

If Not name_rg Is Nothing then
   Template.[a61] = Evaluation.cells(name_rg.row, 29)
Else
   MsgBox("No student found")
End If

3) 在开始处添加下面这行，它会让你的代码更快

Application.ScreenUpdating = False

4) 在你的代码结束时，清除内存并将屏幕更新返回到 True:

Set name_rg = Nothing
Set Template = Nothing
Set Evaluations = Nothing

Application.ScreenUpdating = True

~ 你的代码应该是这样的：

 Option Explicit

 Sub Test()
    Application.ScreenUpdating = False

    Dim StudentName As String
    Dim Template As Worksheet 
    Dim Evaluations As Worksheet 
    Dim finalrow As Integer
    Dim i As Integer
    Dim name_rg As range

    Set Template = ThisWorkbook.Sheets("Evaluation Form Template")
    Set Evaluations = ThisWorkbook.Sheets("Evaluations")

    Template.Range("A61:A70").ClearContents

    ' ~ Search name of the student ~
    Set name_rg = Evaluation.columns(1).Find(Template.[a1])

    If Not name_rg Is Nothing then
       Template.[a61] = Evaluation.cells(name_rg.row, 29)
    Else
       MsgBox("No student found")
    End If

    Set name_rg = Nothing
    Set Template = Nothing
    Set Evaluations = Nothing

    Application.ScreenUpdating = True
End Sub

编辑：
如果 Template 中有多名学生，您将需要执行 For Loop 而不是使用 Range.Find 解决方案。下面的修改：

Sub Test()
    Application.ScreenUpdating = False

    Dim Template As Worksheet
    Dim Evaluations As Worksheet
    Dim Nb_Rows As Integer
    Dim i As Integer
    Dim x, Row as Integer

    Set Template = ThisWorkbook.Sheets("Evaluation Form Template")
    Set Evaluations = ThisWorkbook.Sheets("Evaluations")

    Template.Range("A61:A70").ClearContents

    ' the table in this example starts in A1
    ' please mind that blank lines might cause issues
    Nb_Rows = Evaluations.[a1].CurrentRegion.Rows.Count
    Row = 61 ' first row to input results in Template
    x = 0    ' needed to increment

    For i = 1 to Nb_Rows
        If Evalutations.Cells(i, 1) = Template.[a1] Then
            Template.cells(Row + x, 1) = Evalutations.Cells(i, 29)
            x = x + 1
        End If
    Next i

    Set Template = Nothing
    Set Evaluations = Nothing

    Application.ScreenUpdating = True
End Sub

循环查找匹配搜索条件的记录，然后在两个电子表格之间剪切和粘贴

Loop to Find Records Matching Search Criteria then cut and paste between two spreadsheets

vba

loops

copy-paste

string-matching