Set Rng появляется как Nothing

Question

Мне нужна помощь по нижеуказанному, если можете.

Я работаю между двумя рабочими книгами и хочу, чтобы в первой из них было найдено значение Ячейка ("B6"), которое является датой для второй Рабочей книги в столбце B. Хотя кажется, чтоКод находит дату, когда он устанавливает его как диапазон, он становится пустым.Не могли бы вы помочь мне понять, что я делаю не так.

Я новичок в VBA и пытаюсь с помощью онлайн-поиска сделать мою жизнь проще.Заранее спасибо.

Sub Update_Forecast_2()
    Dim myFile As String
    Dim YourFolderPath As Variant
    Dim FindString As Date
    Dim newFile As String
    FindString = CLng(Date)
    Dim Rng As Range

    YourFolderPath = "C:\Users\konstand\Desktop\Forecast"
    ChDir YourFolderPath
    myFile = Application.GetOpenFilename
    If myFile = "False" Then Exit Sub
    Workbooks.Open Filename:=myFile
    newFile = Replace(myFile, YourFolderPath + "\", "")

    Range("B6").Select
    Workbooks("Forecast file.xlsm").Activate
    Sheets("Forecast_Sort").Activate
    Range("A1").FormulaR1C1 = myFile
    Workbooks(newFile).Activate
    Range("B6").Activate
    FindString = Workbooks(newFile).Sheets("Forecast").Range("B6").Value
    'MsgBox FindString
    If Trim(FindString) <> "" Then
        With Workbooks("Forecast file").Sheets("Forecast_Sort").Range("B:B")
            Set Rng = .Find(What:=DateValue(FindString), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
            Rng.Select
            End If
            Workbooks("Forecast file.xlsm").Activate
        End With
    End If
End Sub

Следуя просьбе Эрджона, чтобы помочь вам лучше понять, что я пытаюсь сделать, я приложил 2 картинки и что-то объяснил.Я надеюсь, что помог и не сделал это более запутанным.

Итак, у меня есть основной файл, в котором я хочу увидеть изменения

Основной файл

Тогда у меня есть файл, из которого я хочу получать обновленные значения каждую неделю, если не чаще.Помните, что каждый раз этот файл будет иметь другое имя, например, «Wk09Update.xlsx», «Wk10Update.xlsx», «Wk11Update.xlsx», .......

Хотя, прежде чем я уйдув новый файл, чтобы скопировать и вставить новые значения, которые я хочу, в основной файл с даты, когда новый файл начинает копировать значения из столбцов H, I и J и вставлять их поверх существующих значений в столбцах C,D, & E. Затем я хочу перейти к новому файлу и скопировать / вставить обновленные значения оттуда в столбцы H, I и J в главном файле, чтобы я мог видеть различия между обновлениями от недели к неделе.

Новый файл (Wk11Update.xlsx)

Как и должно быть после Wk12Update

Что япытается сделать

Переменная объекта или С переменной блока не установлено

Answer 1

Прежде всего, вам нужно сделать свой код простым, например, у вас много .Activate. Это наверняка в какой-то момент приведет вас в замешательство.

Вы должны сначала объявить все свои рабочие листы и рабочие тетради следующим образом:

Sub Test()
dim book1 as workbook 'a workbook
dim book2 as workbook 'another workbook

dim SheetOfBook1 as worksheet 
dim SheetOfBook2 as worksheet 

set book1 = workbooks("NameOfWorkbook1.xlsm")
set book2 = workbooks("NameOfWorkbook2.xlsm")

set SheetOfBook1 = book1.worksheets("NameOfSheet")
set SheetOfBook2 = book2.worksheets("NameOfSheet")

'at this point you can check everything you want without activating something for example

 SheetOfBook1.range("A1") = SheetOfBook2.Range("A1") 'or whatever

'if you want to check if a value in book1 exists in book2 then do a loop

 dim cell as range

 for each cell in SheetOfBook2.Range("A1:A100).Cells
    If SheetOfBook1.range("A1") = Cell.Value Then
       msgbox "I founded what you are searching for"
    End If
 Next Cell
 End Sub

То есть вы должны устранить все это .activate, использовать циклы и т. Д. Что касается вашего примера, вы можете отредактировать свой вопрос и проиллюстрировать изображением то, чего вы хотите достичь?

Редактировать

Если вы хотите открыть рабочие книги по номеру недели, у меня есть следующий код:

Sub Test()
Dim Main As Workbook
Dim Update As Workbook

Dim ForecastSort As Worksheet
Dim Forecast As Worksheet

Dim CheckIfOpen
Dim WeekNumber As String
Dim FirstDayInWeek

Dim FirstDayOfWeekRow As Long

Dim lRowUpdate As Long

Set Main = Workbooks("Main.xlsm")
Set ForecastSort = Main.Worksheets("Forecast_Sort")

'The code below will open the workbook which for name has the number week of today date automatically----------------------------------------------

 WeekNumber = WorksheetFunction.WeekNum(Date) + 1 'The requested week

 CheckIfOpen = IsWorkBookOpen("C:\Users\Erjon-PC\Desktop\Forecast\Wk" & 
 WeekNumber & "Update.xlsx") 'Checks if the update workbook is opened or not

 FirstDayInWeek = Date - Weekday(Date, vbUseSystem) + 2 'First day of requested week

 FirstDayOfWeekRow = ForecastSort.Range("B:B").Find(FirstDayInWeek).Row 'Finds the row of the start day of the requested week in main book


If CheckIfOpen = True Then
    Set Update = Workbooks("Wk" & WeekNumber & "Update.xlsx")
Else
    Set Update = Workbooks.Open("C:\Users\Erjon-PC\Desktop\Forecast\Wk" & WeekNumber & "Update.xlsx")
End If
'---------------------------------------------------------------------------------------------------------------------------------------------------
Set Forecast = Update.Worksheets("Forecast")

lRowUpdate = Forecast.Cells(Forecast.Rows.Count, "W").End(xlUp).Row 'Last row in column W in update book

Forecast.Range("W2:Y" & lRowUpdate).Copy

ForecastSort.Range("H" & FirstDayOfWeekRow).PasteSpecial xlPasteValues

Update.Close savechanges:=False

End Sub

Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0:    IsWorkBookOpen = False
Case 70:   IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function

Приведенный выше код откроет рабочую книгу с номером недели в названии, сегодня он откроет Wk11Update.xlsx, а на следующей неделе откроет Wk12Update.xlsx.

Если вы хотите открыть книги с именами на будущие даты, просто добавьте +1 или больше к этому коду:

WeekNumber = WorksheetFunction.WeekNum(Date) + 1 'The requested week

Затем в открытой книге он найдет последнюю строку с данными в столбце W, скопирует 3 столбца, начиная с W, и вставит их в столбец H основной книги. Данные будут вставлены в строку, где указан первый день запрашиваемой недели.