Excel VBA Costum公式太慢

我有这个vba excel costum公式：

'=ConcatenateRangeIfs(A1;Sheet2!C:C;B1;Sheet2!D:D;Sheet2!G:G;". ") Function ConcatenateRangeIfs( _ ByVal match_val1 As String, _ ByVal match_range1 As Range, _ ByVal match_val2 As String, _ ByVal match_range2 As Range, _ ByVal concatenate_range As Range, _ Optional ByVal separator As String _ ) As String 'disable uncessary processing to improve performance Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Dim concatedString As String Dim toConcatenateCellValue As String Dim toConcatenateCellRow As Long For Each toConcatenateCell In concatenate_range.SpecialCells(xlConstants, 23) toConcatenateCellValue = toConcatenateCell.Value If Not IsEmpty(toConcatenateCellValue) Then toConcatenateCellRow = toConcatenateCell.Row If match_val1 = match_range1.Cells(toConcatenateCellRow, 1).Value Then If match_val2 = match_range2.Cells(toConcatenateCellRow, 1).Value Then concatedString = concatedString & (separator & toConcatenateCellValue) End If End If End If Next toConcatenateCell If Len(concatedString) <> 0 Then concatedString = Right$(concatedString, (Len(concatedString) - Len(separator))) End If 'enable disabled processing ConcatenateRangeIfs = concatedString Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True End Function 

sheet2示例：

公式在D列的D：D单元格中的sheet1示例：

不明白为什么，但是每次更改公式中使用的任何值时，都会花费太长时间并冻结excel。 我已经尝试禁用不必要的Excel的东西，并使用本地veriables访问对象的属性，但并没有太多的变化…

任何消化改善performance？

Answer 1

这应该会更快：

 Option Explicit '=ConcatenateRangeIfs(A1;Sheet2!C:C;B1;Sheet2!D:D;Sheet2!G:G;". ") Function ConcatenateRangeIfs( _ ByVal match_val1 As String, _ ByRef match_range1 As Variant, _ ByVal match_val2 As String, _ ByRef match_range2 As Variant, _ ByRef concatenate_range As Variant, _ Optional ByVal separator As String _ ) As String Dim concatedString As String Dim toConcatenateCellValue As String Dim j As Long ' get data into variant arrays 5 If TypeOf match_range1 Is Range Then Set match_range1 = Intersect(match_range1.Parent.UsedRange, match_range1) match_range1 = match_range1.Value2 End If If TypeOf match_range2 Is Range Then Set match_range2 = Intersect(match_range2.Parent.UsedRange, match_range2) match_range2 = match_range2.Value2 End If If TypeOf concatenate_range Is Range Then Set concatenate_range = Intersect(concatenate_range.Parent.UsedRange, concatenate_range) concatenate_range = concatenate_range.Value2 End If ' ' assumes all arrays are equal length - no error checking ' For j = 1 To UBound(match_range1) If Not IsEmpty(concatenate_range(j, 1)) Then If match_val1 = match_range1(j, 1) Then If match_val2 = match_range2(j, 1) Then concatedString = concatedString & (separator & concatenate_range(j, 1)) End If End If End If Next j If Len(concatedString) <> 0 Then concatedString = Right$(concatedString, (Len(concatedString) - Len(separator))) End If ConcatenateRangeIfs = concatedString End Function