Question

我有两个开放的工作簿。如果学生记录匹配，我尝试将现有笔记从一个工作簿复制到另一个工作簿。下面是我的代码。但是，运行时错误'91'出现，未设置对象变量或With块变量。任何帮助将不胜感激。

Option Explicit
Public Function SheetFromCodeName(aName As String, Optional wb As Workbook) As Worksheet
Dim sh As Worksheet
For Each sh In wb.Worksheets
    If sh.CodeName = aName Then
       Set SheetFromCodeName = sh
       Exit For
    End If
Next sh
End Function

Sub Note_Transfer()
Dim lastrow As Long: lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim MatchRow As Long
Dim i As Long
Dim sh_old As Worksheet
Dim sh_new As Worksheet

Set sh_old = SheetFromCodeName("Sheet1", Workbooks(Workbooks.Count - 1))
Set sh_new = SheetFromCodeName("Sheet1", Workbooks(Workbooks.Count))

For i = 2 To lastrow
If Cells(i, 25) <> "New student" Then
MatchRow = Application.WorksheetFunction.Match(Cells(i, 23).Value, sh_new.Range("W:W"), 0)
sh_old.Range(Cells(MatchRow, 26), Cells(MatchRow, 32)).Copy _
Destination:=sh_new.Range(Cells(i, 26), Cells(i, 32))

End If
Next

End Sub

Answer 1

Worksheet.CodeName是不是字符串。它是一个工作表对象，即使该字符串看起来像CodeName，也无法将其与字符串进行比较。

将CodeName的名称与字符串进行比较会将字符串与字符串进行比较。强制同时使用大写或小写，以避免基于大小写的误报。

Public Function SheetFromCodeName(aName As String, Optional wb As Workbook) As Worksheet

    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If lcase(sh.CodeName.Name) = lcase(Name) Then
           Set SheetFromCodeName = sh
           Exit For
        End If
    Next sh

End Function

Answer 2

谢谢大家的帮助！修改后的代码粘贴在下面。而且效果很好。

Option Explicit

Public Function SheetFromCodeName(aName As String, wb As Workbook) As Worksheet

    Dim sh As Worksheet
    For Each sh In wb.Worksheets
        If sh.CodeName = aName Then
           Set SheetFromCodeName = sh
           Exit For
        End If
    Next sh

End Function

Sub Note_Transfer()


    Dim lastrow As Long
    Dim MatchRow As Long
    Dim i As Long
    Dim sh_old As Worksheet
    Dim sh_new As Worksheet

    Set sh_old = SheetFromCodeName("Sheet1", Workbooks(Workbooks.Count - 1))
    Set sh_new = SheetFromCodeName("Sheet1", Workbooks(Workbooks.Count))

    sh_new.Activate

    lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastrow

    If Cells(i, 25) <> "New patient" Then

    MatchRow = Application.WorksheetFunction.Match(Cells(i, 23).Value, sh_old.Range("W:W"), 0)

    sh_new.Range(sh_new.Cells(i, 26), sh_new.Cells(i, 32)).Value = sh_old.Range(sh_old.Cells(MatchRow, 26), sh_old.Cells(MatchRow, 32)).Value

    End If
Next

End Sub

VBA数据根据单元格值传输到其他工作簿

2 个答案: