如何通过消除循环来优化我的代码？

Question

sub macro() 用于从另一个 sheet 复制值并仅从每个单元格中提取前 2 个单词，然后比较所有单元格并计算重复的单元格我想通过消除一个循环来简化我的代码，似乎可以消除第三个循环。

第一个循环用于从另一个循环复制值 sheet 并使用 getsummary 函数从每个单元格中仅提取前 2 个单词。

第二个和第三个循环用于比较所有单元格然后计算重复的单元格

Public Function GetSummary(text As String, num_of_words As Long) As String
    If (num_of_words <= 0) Then
        GetSummary = ""
        Exit Function
    End If

    Dim words() As String
    words = Split(text, " ")
    
    Dim wordCount As Long
    wordCount = UBound(words) + 1

    Dim result As String

    Dim i As Long
    i = 0
    Do While (i < num_of_words And i < wordCount)
        result = result & " " & words(i)
        i = i + 1
    Loop

    GetSummary = result
End Function

sub macro()
Dim i As Long, j As Long, z As Long, cell As Range, rng As Range, rng2 As Range, A As String, k As Integer, var As String
k = 0
var = Application.InputBox(prompt:="nom du sheet")
Sheets.Add.Name = var
If var = "" Then
Exit Sub
Else
   For i = 7 To 2585
   Set cell = Worksheets("MRT").Range("E" & i)
   A = cell.Value
     Worksheets(var).Range("C" & i).Value = GetSummary(A, 2)
     Worksheets(var).Range("B" & i) = cell
   Next i
End If
For j = 7 To 2585
    Set rng = Worksheets(var).Range("C" & j)
    If rng = "" Then
    rng.Offset(0, 1) = ""
    Else
    For z = 7 To 2585
      Set rng2 = Worksheets(var).Range("C" & z)
      If rng2 = rng Then
      k = k + 1
      End If
    Next z
    rng.Offset(0, 1) = k
    k = 0
    End If

Next j
End Sub

Answer 1

试试这个：

Sub macro()
    Dim i As Long, j As Long, var As String, start As Long, finish As Long, countRange As Range, inCache, outCache
    start = 7: finish = 2585
    var = Application.InputBox(prompt:="nom du sheet")
    Sheets.Add.Name = var
    If var = "" Then
        Exit Sub
    Else
        inCache = Worksheets("MRT").Cells(start, 5).Resize(finish - start + 1, 1).Value2
        outCache = Worksheets(var).Cells(start, 2).Resize(finish - start + 1, 2).Value2
        For i = start - 6 To finish - 6
            outCache(i, 1) = inCache(i, 1)
            outCache(i, 2) = GetSummary(CStr(inCache(i, 1)), 2)
        Next i
        Worksheets(var).Cells(start, 2).Resize(finish - start + 1, 2).Value2 = outCache
    End If
    
    outCache = Worksheets(var).Cells(start, 3).Resize(finish - start + 1, 2).Value2
    Set countRange = Worksheets(var).Cells(start, 3).Resize(finish - start + 1)
    For j = start - 6 To finish - 6
        If outCache(j, 1) = vbNullString Then
            outCache(j, 2) = vbNullString
        Else
            outCache(j, 2) = WorksheetFunction.CountIf(countRange, outCache(j, 1))
        End If
    Next j
    Worksheets(var).Cells(start, 3).Resize(finish - start + 1, 2).Value2 = outCache
End Sub

如何通过消除循环来优化我的代码？

how to optimize my code by eliminating a loop?

excel

vba

loops