如果可以,我想在下面给一些帮助。
我正在两个工作簿之间工作,我希望从第一个工作簿中找到Cell(“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
遵循Erjon的要求,为了帮助您更多地了解我正在尝试做什么,我附上了2张照片,并解释了一些东西。我希望我帮助并且不会让它更加混乱。
所以我有一个主要文件,我希望看到这些变化
然后我有一个文件,我想每周更新一次,如果不是更频繁的话。请注意,此文件每次都会有不同的名称,例如“Wk09Update.xlsx”,“Wk10Update.xlsx”,“Wk11Update.xlsx”,.......
虽然在我转到新文件之前,从新文件开始复制H,I和J列的值之后,在主文件上复制并粘贴我想要的新值,然后将它们粘贴到现有值之上在C,D和E列中。然后我想转到新文件并将更新后的值从那里复制/粘贴到主文件中的H,I和J列,这样我就可以看到一周到一周的不同之处更新。
首先,您需要使代码变得简单,例如,您有很多.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列中找到包含数据的最后一行,它将从W开始复制3列,并将它们粘贴到主书的H列中。数据将粘贴在请求周的第一天所在的行中。