我的EXCEL VBA Script极低，尽pipe它很短

这是我写的一个脚本。 我在610行左右的表单上运行它，这需要很多时间，直到它给我一个输出，而且每次我在这个范围内更改一个值的内容后，我都要等待10-15秒左右。

Function csvRangeNew(myRange As Range) Dim csvRangeOutput Dim entry As Variant For Each entry In myRange If Not IsEmpty(entry.Value) Then If entry.Value = "New" Then If Not IsEmpty(Worksheets("wholelist").Range("A" & entry.Row)) Then csvRangeOutput = csvRangeOutput & Worksheets("wholelist").Range("A" & entry.Row).Value & "," End If End If End If Next csvRangeNew = Left(csvRangeOutput, Len(csvRangeOutput) - 1) End Function 

基本上，我正在尝试做的是，当我将列“B”中的单元格值设置为“新build”时，它将添加到逗号分隔的列表中。

Answer 1

正如Doug Coats在评论中所述，您正在处理一列中的每个单元格。 解决方法：把set myRange = intersect(myRange , myRange.parent.usedrange)作为函数内的第一行。

 Function csvRangeNew(myRange As Range) Dim csvRangeOutput Dim entry As Variant set myRange = intersect(myRange , myRange.parent.usedrange) For Each entry In myRange If Not IsEmpty(entry.Value) Then If entry.Value = "New" Then If Not IsEmpty(Worksheets("wholelist").Range("A" & entry.Row)) Then csvRangeOutput = csvRangeOutput & Worksheets("wholelist").Range("A" & entry.Row).Value & "," End If End If End If Next csvRangeNew = Left(csvRangeOutput, Len(csvRangeOutput) - 1) End Function 

相交命令会将myRange截断为工作表的使用部分。

Answer 2

我无法弄清楚你的代码是干什么的（特别是为什么你说你想跟踪B列中的改变，但是你的代码引用了列A），或者当列B改变时它是如何被触发的。 看起来你正在试图获取添加单词“new”的单元格区域，并将该范围添加到以逗号分隔的列表中，但范围是对象，因此您不能将它们添加到string中。

假设您试图将其值已更改为“新”的单元格的地址添加到以逗号分隔的列表中。 把这个代码放在整个表单模块中。 逗号分隔的列表将在公共variablescsvRangeNew中可用。

请注意，这只适用于在进行更改时保留运行列表。 您需要在closures工作簿之前将csvRangeNew值保存在某处，或者在打开工作簿时重新计算并重置该值以保留现有值。

 Option Explicit Public csvRangeNew As String Private Sub Worksheet_Change(ByVal Target As Range) If (Target.Address = "$B:$B") Then 'clearing or deleting column B GetCsvRangeNew bClearRange:=True ElseIf (Target.Column = 2) Then If UCase(Target.Value) = "NEW" Then csvRangeNew = GetCsvRangeNew(myRangeAddress:=Target.Address) End If End If Debug.Print csvRangeNew End Sub Function GetCsvRangeNew(Optional myRangeAddress As String, _ Optional bClearRange As Boolean) As String Static csvRangeOutput As String If bClearRange Then csvRangeOutput = "": Exit Function If (csvRangeOutput = "") Then csvRangeOutput = myRangeAddress Else csvRangeOutput = csvRangeOutput & "," & myRangeAddress End If GetCsvRangeNew = csvRangeOutput End Function