Вопрос:
У меня есть следующий макрос, чтобы отфильтровать определенные данные из моего каталога с файлами часов сотрудников и поместить его в файл zmaster. Тем не менее, мне нужны различные основные документы для различных проектов (EG. Change name to: “project 300000”). Когда я меняю имя главного файла из zmaster на что-либо еще, мой макрос не может найти соответствующий файл, очевидно.
Есть ли способ изменить мой макрос таким образом, что zmaster.xlsm автоматически заменяется в моем макросе текущим именем файла?
Option Explicit Sub CopyToMasterFile() Dim MasterWB As Workbook Dim MasterSht As Worksheet Dim MasterWBShtLstRw As Long Dim FolderPath As String Dim TempFile Dim CurrentWB As Workbook Dim CurrentWBSht As Worksheet Dim CurrentShtLstRw As Long Dim CurrentShtRowRef As Long Dim CopyRange As Range Dim ProjectNumber As String FolderPath = «C:test» TempFile = Dir(FolderPath) Dim WkBk As Workbook Dim WkBkIsOpen As Boolean ‘Check if zmaster is open already For Each WkBk In Workbooks If WkBk.Name = «zmaster.xlsm» Then WkBkIsOpen = True Next WkBk If WkBkIsOpen Then Set MasterWB = Workbooks(«zmaster.xlsm») Set MasterSht = MasterWB.Sheets(«Sheet1») Else Set MasterWB = Workbooks.Open(FolderPath & «zmaster.xlsm») Set MasterSht = MasterWB.Sheets(«Sheet1») End If ProjectNumber = MasterSht.Cells(1, 1).Value Do While Len(TempFile) > 0 ‘Checking that the file is not the master and that it is a xlsx If Not TempFile = «zmaster.xlsm» And InStr(1, TempFile, «xlsx», vbTextCompare) Then Set CopyRange = Nothing ‘Note this is the last used Row, next empty row will be this plus 1 With MasterSht MasterWBShtLstRw = .Cells(.Rows.Count, «A»).End(xlUp).Row End With Set CurrentWB = Workbooks.Open(FolderPath & TempFile) Set CurrentWBSht = CurrentWB.Sheets(«Sheet1») With CurrentWBSht CurrentShtLstRw = .Cells(.Rows.Count, «A»).End(xlUp).Row End With For CurrentShtRowRef = 1 To CurrentShtLstRw If CurrentWBSht.Cells(CurrentShtRowRef, «A»).Value = ProjectNumber Then ‘This is set to copy from Column A to Column L as per the question If CopyRange Is Nothing Then ‘If there is nothing in Copy range then union wont work ‘so first row of the work sheet needs to set the initial copyrange Set CopyRange = CurrentWBSht.Range(«A» & CurrentShtRowRef & _ «:L» & CurrentShtRowRef) Else ‘Union is quicker to be able to copy from the sheet once Set CopyRange = Union(CopyRange, _ CurrentWBSht.Range(«A» & CurrentShtRowRef & _ «:L» & CurrentShtRowRef)) End If ‘ ending If CopyRange Is Nothing …. End If ‘ ending If CurrentWBSht.Cells…. Next CurrentShtRowRef CopyRange.Select ‘add 1 to the master file last row to be the next open row CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1) CurrentWB.Close savechanges:=False End If ‘ending If Not TempFile = «zmaster.xlsx» And …. TempFile = Dir Loop ActiveSheet.Range(«A1:L200»).RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes End Sub Лучший ответ:
Один из способов избежать записи с жесткой кодировкой – использовать объекты ActiveWorkbook или ThisWorkbook – они возвращают экземпляр объекта Workbook.
ThisWorkbook
Возвращает объект Workbook, который представляет книгу, в которой выполняется текущий макрокоманд. Только для чтения.
ActiveWorkbook
Возвращает объект рабочей книги, который представляет книгу в активном окне (окно сверху). Только для чтения. Возвращает ничего, если нет открытых окон или если активным является окно Info или окно буфера обмена.
Затем вы можете получить имя рабочей книги с именем свойства возвращаемого объекта рабочей книги.
Другой способ может быть, если вы передадите такие данные как параметр своим функциям. Например:
Sub CopyToMasterFile(wbName as String, sheetName as String)
В этом варианте, если вы вызываете свой Sub из другого макрокода, вы можете передавать все, что хотите, – таким образом вы можете избежать жестко закодированных вещей в своих функциях.
Это также справедливо для объектов Worksheet – посмотрите на ActiveSheet
