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

我不确定如何执行以下任务：

目前，计数被粘贴在＆＃34;延迟＆＃34; sheet，但我想将其粘贴到名为＆＃34; MySheet＆＃34;
如何从多行添加多个条件？目前它只适用于＆＃34; COMPATIBLE＆＃34;在＆＃34; E＆＃34;，如果我需要为＆＃34; XYZ＆＃34;添加额外的标准怎么办？在＆＃34; X＆＃34;列？

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

粘贴本身发生在sub：

的末尾

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

要添加新条件，我们会指定条件＆amp;范围并将它们添加到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

使用VBA在不同的工作表中粘贴计数

1 个答案: