sub macro() 用于從另一張表中復制值并僅從每個單元格中提取 2 個第一個單詞然后比較所有單元格并計算重復的單元格我想通過消除看起來像第三個的回圈來簡化我的代碼回圈可以消除。
第一個回圈用于從另一張表中復制值，并使用 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
uj5u.com熱心網友回復：
試試這個：
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/473811.html