改變輸出片

Question

我有下面的代碼，這將使根據日期基於一些過濾器計數。 但問題是我想改變O/P粘貼的目的地。

目前計算是在「延遲」表單上完成的，而O/P是粘貼在那裏的。我只是想改變輸出到細胞AE5在片「WBR45」

Option Explicit 

Const strFormTitle = "Enter Minimum and Maximum Dates in d/m/yyyy format" 'Edit for different regional date format 
Const strShtName As String = "Latency"    'Name of worksheet with ranges to be processed 
Const strDateFormat As String = "d mmm yyyy"  'Edit for different regional date format 
Const strCrit1 As String = "Pass, Fail, In Progress" 'Criteria for output to AE2. (Can insert or delete criteria with comma between values. OK to have spaces with the commas) 
Const strCrit2 As String = "COMPATIBLE"  'Criteria for column E. (One criteria only) 
Const strDateRng As String = "K:K"  'Column with Dates 
Const strCrit1Col As String = "O:O"  'Column with "Pass, Fail, In Progress" 
Const strCrit2Col As String = "E:E"  'Column with "COMPATIBLE" 
Const strOutput1 As String = "AE2"  'The cell for output "Pass, Fail, In Progress" 
Const strOutput2 As String = "AF2"  'The cell for output "Pass, Fail, In Progress" plus "COMPATIBLE" 



Private Sub UserForm_Initialize() 
    Me.lblTitle = strFormTitle 
End Sub 

Private Sub cmdProcess_Click() 
    Dim wf As WorksheetFunction 
    Dim ws As Worksheet 
    Dim rngDates As Range  'Range of dates 
    Dim rngCrit1 As Range  'Range to match Criteria 1 
    Dim rngCrit2 As Range  'Range to match Criteria 2 
    Dim dteMin As Date 
    Dim dteMax As Date 
    Dim rngOutput1 As Range 
    Dim rngOutput2 As Range 
    Dim arrSplit As Variant 
    Dim i As Long 

    Set wf = Application.WorksheetFunction 
    Set ws = Worksheets(strShtName) 
    With ws 
     Set rngDates = .Columns(strDateRng) 
     Set rngOutput1 = .Range(strOutput1) 
     Set rngOutput2 = .Range(strOutput2) 
     Set rngCrit1 = .Range(strCrit1Col) 
     Set rngCrit2 = .Range(strCrit2Col) 
    End With 

    dteMin = CDate(Me.txtMinDate) 
    dteMax = Int(CDate(Me.txtMaxDate) + 1) 

    If dteMin > dteMax Then 
     MsgBox "Minimum date must be less than maximum date." & vbCrLf & _ 
     "Please re-enter a valid dates." 
     Exit Sub 
    End If 

    arrSplit = Split(strCrit1, ",") 

    'Following loop removes any additional leading or trailing spaces (Can be in the string constant) 
    For i = LBound(arrSplit) To UBound(arrSplit) 
     arrSplit(i) = Trim(arrSplit(i)) 
    Next i 

    rngOutput1.ClearContents 'Start with blank cell 
    For i = LBound(arrSplit) To UBound(arrSplit) 
    rngOutput1.Value = rngOutput1.Value + wf.CountIfs(rngDates, ">=" & CLng(dteMin), _ 
       rngDates, "<" & CLng(dteMax), _ 
       rngCrit1, arrSplit(i)) 
    Next i 

    rngOutput2.ClearContents 'Start with blank cell 
    For i = LBound(arrSplit) To UBound(arrSplit) 
    rngOutput2.Value = rngOutput2.Value + wf.CountIfs(rngDates, ">=" & CLng(dteMin), _ 
       rngDates, "<" & CLng(dteMax), _ 
       rngCrit1, arrSplit(i), rngCrit2, strCrit2) 
    Next i 

End Sub 


Private Sub cmdCancel_Click() 
    Unload Me 
End Sub 

Private Sub txtMinDate_AfterUpdate() 
    If IsDate(Me.txtMinDate) Then 
     Me.txtMinDate = Format(CDate(Me.txtMinDate), strDateFormat) 
    Else 
     MsgBox "Invalid Minimum date. Please re-enter a valid date." 
    End If 
End Sub 

Private Sub txtMaxDate_AfterUpdate() 

    If IsDate(Me.txtMaxDate) Then 
     Me.txtMaxDate = Format(CDate(Me.txtMaxDate), strDateFormat) 
    Else 
     MsgBox "Invalid Maximum date. Please re-enter a valid date." 
    End If 
End Sub 

Private Sub chkEntireRng_Click() 
    Dim wf As WorksheetFunction 
    Dim ws As Worksheet 
    Dim rngDates As Range 

    Set wf = WorksheetFunction 
    Set ws = Worksheets(strShtName) 
    With ws 
     Set rngDates = .Columns(strDateRng) 
    End With 
    If Me.chkEntireRng = True Then 
     Me.txtMinDate = Format(wf.Min(rngDates), strDateFormat) 
     Me.txtMaxDate = Format(wf.Max(rngDates), strDateFormat) 
     Me.txtMinDate.Enabled = False 
     Me.txtMaxDate.Enabled = False 
    Else 
     Me.txtMinDate = "" 
     Me.txtMaxDate = "" 
     Me.txtMinDate.Enabled = True 
     Me.txtMaxDate.Enabled = True 
    End If 

End Sub 

Answer 1

有很多可以做，以精簡和簡化這一代碼，但在目前情況下，這是我認爲你需要做的。

後

Const strShtName As String = "Latency" 

添加

Const StrOPName as string = "WBR45" 

變化

Const strOutput1 As String = "AE2" 

到

Const strOutput1 As String = "AE5" 

的d我想改變

Const strOutput2 As String = "AF2" 

到

`Const strOutput2 As String = "AF5"` 'not sure if this is what you want as well 

添加

Dim wsOP As Worksheet 

後

dim ws as worksheeet 

和 設置wsOP = sheets (strOPname) 後set ws = worksheets (strShtName)

藉此走出 「與WS」 部分

Set rngOutput1 = .Range(strOutput1) 
Set rngOutput2 = .Range(strOutput2) 

，並在達到rngoutput1.value語句時後， 「結束與」

Set rngOutput1 = wsOP.Range(strOutput1) 
Set rngOutput2 = wsOP.Range(strOutput2) 

然後，添加此，目標範圍將是wsOP.range（「AE5」）

和rngoutput2.value將移動到AF5 我認爲這就是您需要的。擺弄它一下。