Перенос данных VBA в другую книгу на основе значения ячейки - PullRequest
Новая
       17

Перенос данных VBA в другую книгу на основе значения ячейки

0 голосов
/ 01 марта 2019

У меня есть две вводные книги.Я пытался скопировать существующую заметку из одной рабочей тетради в другую, если запись студента совпадает.Ниже мой код.Однако во время выполнения появляется ошибка «91», что переменная объекта или переменная блока не установлены.Любая помощь будет принята с благодарностью.

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

Ответы [ 2 ]

0 голосов
/ 03 марта 2019

Спасибо всем за помощь!Измененный код вставлен ниже.И это хорошо работает.

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
0 голосов
/ 01 марта 2019

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
...