使用VBA在不同的表格中粘貼計數

Question

我有下面的代碼將根據日期範圍計算某些字符串並更新單元格中的計數。

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 

我不知道該怎麼做了以下任務：

1. 目前計數的「潛伏」片粘貼，但我想它粘貼到名爲「MySheet的工作」
表
2. 如何從多行添加多個條件？目前它僅僅是用於「E」中的「COMPATIBLE」，如果我需要在「X」列中添加「XYZ」的附加條件，該怎麼辦？

Answer 1

該代碼似乎不必要地用過多的指針進行混淆，它可能是很好的練習/學習嘗試重構它。

1：這些行用於創建等待時間表對象和輸出範圍。我建議爲「Mysheet」做同樣的事情。由於您尚未指定數據是否也位於MySheet中，因此我們需要假定它仍然位於同一位置，並且不會觸摸現有引用。

Const strShtName As String = "Latency"    'Name of worksheet with ranges to be processed 
Dim ws As Worksheet 
Set ws = Worksheets(strShtName) 
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" 
Dim rngOutput1 As Range 
Dim rngOutput2 As Range 
With ws 
    Set rngOutput1 = .Range(strOutput1) 
    Set rngOutput2 = .Range(strOutput2) 
End With 

我們會在添加以下分配新的工作表對象粘貼範圍：

Dim wsMySheet As Worksheet 
Set wsMySheet = Worksheets("MySheet") 
Dim rngOutputMySheet as range 
With wsMySheet 
    Set rngOutputMySheet = .range("CELLREFHERE") 
End With 

本身發生在子結束時的貼：

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 

你'用您的新產品代替範圍參考（rngOutputMySheet）

2：標準設置如下：

Const strCrit1Col As String = "O:O"  'Column with "Pass, Fail, In Progress" 
Const strCrit1 As String = "Pass, Fail, In Progress" 
Dim rngCrit1 As Range  'Range to match Criteria 1 
With ws 
    Set rngCrit1 = .Range(strCrit1Col) 
End With 

和使用如下：

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 

要添加新的標準，我們會分配的標準&範圍，並將它們添加到COUNTIFS式的條件：

Dim strCrit3 as String 
strCrit3 = "Criteria list here" 
Dim rngCrit3 as Range 
With ws 
    set rngCrit3 = .Range("RANGEHERE") 
End With 
For i = LBound(arrSplit) To UBound(arrSplit) 
    rngOutput2.Value = rngOutput2.Value + wf.CountIfs(rngDates, ">=" & CLng(dteMin), _ 
        rngDates, "<" & CLng(dteMax), _ 
        rngCrit1, arrSplit(i), rngCrit2, strCrit2,rngCrit3, strCrit3) 
Next i