如何优化下面的VB代码？运行需要花费大量时间，并且每次都要挂起Excel

Question

我正在Excel工作表中创建一个需求可追溯性M矩阵，而下面的VB代码需要花费更多的时间执行，并且每次我在单元格中输入内容时excel工作表会挂起5分钟。

---

VBA代码：

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)

    Dim xDic As New Dictionary
    Dim xRows As Long
    Dim xStr As String
    Dim i As Long

    On Error Resume Next
    xRows = LookupRange.Rows.Count
    For i = 1 To xRows
        If LookupRange.Columns(1).Cells(i).Value = Lookupvalue Then
            xDic.Add LookupRange.Columns(ColumnNumber).Cells(i).Value, ""
        End If
    Next
    xStr = ""
    MultipleLookupNoRept = xStr
    If xDic.Count > 0 Then
        For i = 0 To xDic.Count - 1
            xStr = xStr & xDic.Keys(i) & ","
        Next
        MultipleLookupNoRept = Left(xStr, Len(xStr) - 1)
    End If 

End Function

Answer 1

↓连接字典中的所有键↓

extension String {

  func replacing(pattern: String, withTemplate: String) throws -> String {
    let regex = try NSRegularExpression(pattern: pattern, options: .caseInsensitive)
    return regex.stringByReplacingMatches(in: self,
                                          options: [],
                                          range: NSRange(0 ..< utf16.count),
                                          withTemplate: withTemplate)
  }
}

Join(Dictionary.Key(), ",")

---

这是代码的超级修改版本。先前的代码应在2-5秒内处理10K行。

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer) As String

    Dim xDic As New Dictionary
    Dim xRows As Long
    Dim xStr As String
    Dim i As Long

    On Error Resume Next
    xRows = LookupRange.Rows.count
    For i = 1 To xRows
        If LookupRange.Columns(1).Cells(i).Value = Lookupvalue Then
            xDic.Add LookupRange.Columns(ColumnNumber).Cells(i).Value, ""
        End If
    Next

    If xDic.count > 0 Then
        MultipleLookupNoRept = Join(xDic.Keys(), ",")
    End If

End Function