VBA Set Object в операторе If - PullRequest
0 голосов
/ 12 июля 2020

Итак, я создал серию формул на листе под названием Extractor в книге под названием «Processor *». Имя файла книги «Процессор *» обычно может быть разным, справа от него будут другие символы. Я намерен скопировать диапазон, охватывающий всю формулу, которую я создал на листе с именем «Extractor» книги «Процессор *», и вставить в другую книгу «INJ *» с именем файла, также имеющим переменные символы справа, и в частности в рабочий лист с именем «Таблица». После вставки этой формулы он выдаст результаты для различных ячеек, которые мне нужны из «INJ *» на основе некоторых условий, которые я уже установил в своей формуле. Обратите внимание, что формула работает нормально, когда я сам копирую и вставляю. Затем я хочу скопировать эти результаты на другой лист на «Процессоре *». Лист под названием «Расчет». Ниже приведен код, который я написал, но мне кажется, что я не могу заставить объект, определенный в операторе IF, работать вне оператора. У меня есть несколько таких файлов, с которыми я могу работать, буду очень признателен за вашу помощь. Спасибо!

    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, lrow As Long, lrow2 As Long, rng As Range
    
            
             Dim Ct As Long
    For Each WB In Application.Workbooks
        wb1 = Null
        If WB.Name Like "Processor*" Then
            Ct = Ct + 1
            WB.Activate
            Set wb1 = ActiveWorkbook
            Set sh1 = wb1.Sheets("Extractor")
            Set sh2 = wb1.Sheets("calculation")
            Exit For
        End If
    Next WB
    If Ct = 0 Then MsgBox "File not open"
            
    
    Dim Ct2 As Long
    For Each WB In Application.Workbooks
        If WB.Name Like "INJ*" Then
            Ct2 = Ct2 + 1
            WB.Activate
            Set wb2 = ActiveWorkbook
            Set sh3 = wb2.Sheets("Manager Report")
            Set sh4 = wb2.Sheets("TABLE")
            Exit For
        End If
    Next WB
    If Ct2 = 0 Then MsgBox "File not open"
                   
                       
        With wb1
        sh1.Range("C38:J42").Copy wb2.sh4.Range("C38")
        End With
        
        With sh4
        .Range("C42:J42").Copy
        sh2.Range("A" & lrow2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        End With

Ответы [ 2 ]

2 голосов
/ 12 июля 2020
  Dim wbProc As Workbook, wbInj As Workbook, sh1 As Worksheet
  Dim sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
 
  Set wbProc = WorkbookByName("Proc*")
  Set wbInj = WorkbookByName("INJ*")

  If wbProc is nothing or wbInj is nothing then
      msgbox "missing workbook(s)!"
  end if 

  Set sh1 = wbProc.Sheets("Extractor")
  Set sh2 = wbProc.Sheets("calculation")
  Set sh3 = wbInj.Sheets("Manager Report")
  Set sh4 = wbInj.Sheets("TABLE")
                   
  sh1.Range("C38:J42").Copy sh4.Range("C38")
                    
  sh4.Range("C42:J42").Copy
  sh2.Range("A" & lrow2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
  '....
  '....

Функция, использованная выше:

'get an open workbook by [partial] name 
Function WorkbookByName(nm As String) As Workbook
    Dim WB As Workbook
    For Each WB In Application.Workbooks
        If WB.Name Like nm Then
            Set WorkbookByName = WB
            Exit Function
        End If
    Next WB
End Function 

РЕДАКТИРОВАТЬ: вам нужно указать, в какой книге искать лист

Function WorksheetByName(wb As Workbook, nm As String) As Worksheet 
    Dim sh As Worksheet 
    For Each sh In wb.Worksheets '<<<
        If sh.Name Like nm Then 
            Set WorksheetByName = sh 
            Exit Function 
        End If 
    Next sh 
End Function

Затем:

Set sh4 = WorksheetByName(wbInj, "TABLE*")
0 голосов
/ 12 июля 2020

Попробуйте это

Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
Dim lrow As Long, lrow2 As Long, rng As Range


For Each wb In Application.Workbooks
    If wb.Name Like "Processor*" Then
        Set wb1 = wb
        Set sh1 = wb1.Sheets("Extractor")
        Set sh2 = wb1.Sheets("calculation")
        Exit For
    End If
Next wb
If wb1 Is Nothing Then
    MsgBox "File not open"
    Exit Sub
End If

For Each wb In Application.Workbooks
    If wb.Name Like "INJ*" Then
        Set wb2 = wb
        Set sh3 = wb2.Sheets("Manager Report")
        Set sh4 = wb2.Sheets("TABLE")
        Exit For
    End If
Next wb
If wb2 Is Nothing Then
    MsgBox "File not open"
    Exit Sub
End If
  

sh1.Range("C38:J42").Copy sh4.Range("C38")
   
sh4.Range("C42:J42").Copy

'''''''''sh2.Range("A" & lrow2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

lrow2 не имеет значения !!!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...