Excel VBA服装公式太慢答案

【问题标题】：Excel VBA costum formula too slowExcel VBA服装公式太慢
【发布时间】：2017-02-18 19:43:05
【问题描述】：

我有这个 vba excel 服装公式：

'=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 列单元格中的 sheet1 示例：

不明白为什么，但每次我更改公式中使用的任何值时都会花费太长时间并冻结 excel。我尝试禁用不必要的 excel 内容，并使用本地验证来访问对象属性，但没有太大变化......

有什么提高性能的建议吗？

【问题讨论】：

我能发现的第一件事：toConcatenateCellValue = toConcatenateCell.Value 当你没有比赛时不要做这个作业。实际上你根本不需要这个临时变量，它是对所有单元格执行的无用副本，包括那些不匹配的单元格！
A String 永远不可能是 Empty，所以 Not IsEmpty(toConcatenateCellValue) 永远是 True。

标签： vba excel

【解决方案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

【讨论】：