Question

这是我的两个子程序的代码，一个函数，另外两个用于宏保护的子程序（不相关）。最后一个子程序sub manual_date()是我查询的中心。如果此宏的用户选择手动输入自己的日期，我怎么能转移宏代码。主代码突出显示为中心代码屏幕。我知道我可以很容易地复制和粘贴作为解决方案。我对高级编码策略感兴趣。

Option Explicit

Sub Client_Dirty_Recon()

Dim Date_minus_one As Date              ' Date & weekend logic
Dim answer As Long                      ' Date & weekend logic
Dim brow As Long                        ' Last filled cell in column
Dim yrow As Long                        ' Last filled cell in column
Dim nRow As Long                        ' Last filled cell in column
Dim c As Range                          ' rngWatch.Cells(i, 1).Value
Dim oldStatusBar As Variant             ' Save StatusBar status
Dim Client_path As String               ' Range("Path")
Dim wb As Workbook                      ' ThisWorkbook
Dim wbDirty As Workbook                 ' Workbooks.Open(Client_path)
Dim rngReconcile As Range               ' wb.Sheets(1).Range("K:K")
Dim rngWatch As Range                   ' wbDirty.Sheets(1).Range("A:A")
Dim rngNew As Range                     ' wbNew.Sheets(1).Range("A:A")
Dim failed_count As Long
Dim FS


oldStatusBar = Application.DisplayStatusBar     'optional - save StatusBar
Application.DisplayStatusBar = True             'optional - turn on StatusBar
Application.ScreenUpdating = False              'optional - screen won't flash
Application.StatusBar = "Opening workbooks..."  'optional - Update user

Call Unprot

Date_minus_one = Date
answer = IsMonday(Date_minus_one)

If answer = True Then
Date_minus_one = Date - 3
    Else
    Date_minus_one = Date - 1
End If

Set FS = CreateObject("Scripting.FileSystemObject")
Set wb = ThisWorkbook
' Client_path = wb.Names("Path").RefersToRange.Value    ' use path as defined name on sheet
Client_path = "XXXXXXX " & Format(Date_minus_one, "mmddyyyy") & ".xls"


If FS.fileexists(Client_path) Then

' Get only used part of column
Set rngReconcile = wb.Sheets(1).Range("K:K")
nRow = rngReconcile(rngReconcile.Cells.Count).End(xlUp).Row   ' Get last filled cell
Set rngReconcile = Range(rngReconcile(1), rngReconcile(nRow)) ' Reduce rng size

Set wbDirty = Workbooks.Open(Client_path)   ' Assumes it exists and is not open
' Get only used part of column
Set rngWatch = wbDirty.Sheets(1).Range("A:A")
nRow = rngWatch(rngWatch.Cells.Count).End(xlUp).Row     ' Get last filled cell
Set rngWatch = Range(rngWatch(3), rngWatch(nRow))       ' Reduce range size

Set rngNew = wb.Sheets("Client Watchlist").Range("K:K")
brow = rngNew(rngNew.Cells.Count).End(xlUp).Row
Set rngNew = Range(rngNew(2), rngNew(brow))
rngNew.ClearContents

Set rngNew = wb.Sheets(1).Range("K:K")(rngNew.Cells.Count).End(xlUp)(2)

For Each c In rngWatch                   ' Each value in rngWatch
    On Error Resume Next                 ' Interrupt Error checking
    If IsError(WorksheetFunction.Match( _
        c.Value, rngReconcile, 0)) Then  ' If not in rngReconcile
        rngNew.FormulaR1C1 = c.Value     ' Copy to rngNew
        Set rngNew = rngNew(2)           ' Moves range down =Offset(rngNew,1,0)
    End If
    On Error GoTo 0                      ' Reset Error checking
    If (c.Row + 1) Mod 100 = 0 Then      ' Optional - Update user
        Application.StatusBar = "Evaluating cell " & c(2).Address & "..."
    End If
Next c

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar ' Reset Status Bar
ActiveWindow.Close Savechanges:=False       ' Closes client email


MsgBox ("Reconcilied to ") & Client_path & " on " & Now

Else

MsgBox ("Please save down ") & Client_path, vbCritical

End If


Call Prot

Application.ScreenUpdating = True           ' Turn back on

End Sub


Public Function IsMonday(inputdate As Date) As Boolean
    Select Case Weekday(inputdate)
        Case vbMonday
            IsMonday = True
        Case Else
            IsMonday = False
    End Select
End Function

Sub manual_date()
manual_date_input = InputBox("Enter Date (MMDDYYYY")


End Sub

更新

我添加了以下两个子程序，它们将按照下面的说明传递dt参数。我觉得这个变量dt as date好像存储了一个值？我能够运行子过程Sub RunWithUserDate()，但Sub RunWithDefault()过程无法顺利运行。我插入了几个消息框来查看dt的值。我应该重置此日期变量的值吗？如果是这样，我怎么能？（请注意，我已在主要子流程Sub Client_Dirty_Recon()中清理了代码，并且我已在dt变量中正确分配了client_path变量。

Sub test2()
MsgBox Date

MsgBox dt

MsgBox IsMonday(dt)
IsMonday (dt)

MsgBox (dt)

End Sub
Public Function IsMonday(inputdate As Date) As Boolean

    Select Case Weekday(inputdate)
        Case vbMonday
            dt = Date - 3               ' IsMonday = True
            'dt = Format(dt, "mmddyyyy")
        Case Else
            dt = Date - 1
            'dt = Format(Date - 1, "mmddyyyy")           ' IsMonday = False
            'dt = Format(dt, "mmddyyyy")
    End Select

End Function

Sub RunWithDefault()                    ' Button 1: use current date
'CHECK THIS AGAIN ***ALSO ADD PERMISSIONS IF NECESSARY
    MsgBox IsMonday(dt)
    MsgBox dt

    Client_Dirty_Recon IsMonday(dt)


End Sub
                                        ' Button 2: get date from user
Sub RunWithUserDate()                   ' Get dt value from user
'PROMPT USER FOR PASSWORD

    dt = Application.InputBox("Enter Date (MM/DD/YYYY)", "Manual Override")
    'du = Format(du, "mmddyyyy")

    'du = Format(Application.InputBox("Enter Date (MM/DD/YYYY)"), "mmddyyyy")

    'dt = Format(dt, "mmddyyyy")
'MsgBox dt
        Client_Dirty_Recon dt
     'dt = Date


End Sub

Answer 1

将一个Date参数添加到您的主子，并具有（例如）两个单独的按钮，每个按钮链接到较小的＆＃34;存根＆＃34;而这又将调用主代码。第一个会通过当前日期;第二个会以某种方式传递来自用户的日期。

'button 1: use current date
Sub RunWithDefault()
    Client_Dirty_Recon Date
End Sub

'button 2: get date from user
Sub RunWithUserDate()
    Dim dt As Date
    'get dt value from user
    Client_Dirty_Recon dt
End Sub


'main code
Sub Client_Dirty_Recon(dt as Date)
    'run main processing
End Sub

我的参数值是否存储其值，即内存 - 如果单击按钮将宏转移到第二个宏

更新

1 个答案: