Question

我有以下宏来使用员工小时文件从我的目录中过滤特定数据并将其放入我的zmaster文件中。但是，我需要各种项目的各种主文档（EG。将名称更改为：＆＃34;项目300000＆＃34;）。当我将主文件名从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

Answer 1

从硬编码工作簿名称中逃脱的一种方法是使用ActiveWorkbook或ThisWorkbook个对象 - 它们都返回Workbook个对象的实例。

ThisWorkbook

返回表示工作簿的Workbook对象   当前宏代码正在运行的位置。只读。

<强> ActiveWorkbook

返回表示活动中工作簿的Workbook对象   窗口（顶部的窗口）。只读。如果没有，则返回Nothing   窗口打开或如果信息窗口或剪贴板窗口是   活动窗口。

然后，您可以使用返回的Name对象的Workbook属性获取工作簿的名称。

另一种方法是将参数这样的数据传递给函数。例如：

Sub CopyToMasterFile(wbName as String, sheetName as String)

在此变体中，如果您从另一个宏代码调用Sub，则可以传递您想要使用的任何内容 - 这样您就可以逃避函数中的硬编码内容。

这也适用于Worksheet个对象 - 请查看ActiveSheet

更改文件名时自动更新宏

1 个答案: