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

我有下面的代码将根据date范围计算某些string，并更新单元格中的计数。

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：这些行用于创build等待时间表对象和输出范围。 我build议为“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 

你会用新的replace范围引用（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