[attach]13218[/attach]:(
Sub TEST()
' Worksheets("Sheet1").Range("A1:A65530") = Worksheets("Sheet1").Range("B1:B65530") & Worksheets("Sheet1").Range("C1:C65530") '型態不符合
all_number = ThisWorkbook.Sheets("Sheet1").Range("B65536").End(xlUp).Row
For I = 2 To all_number
Cells(I, 1) = Trim(Cells(I, 2)) & Trim(Cells(I, 3))
Next I
End Sub
先填入公式再轉值 寫法如下
Sub sheet1_Formula()
Rn& = [sheet1!B65536].End(3).Row
With [sheet1!A2].Resize(Rn - 1)
.Formula = "=COUNTIF($B$2:$B2,B2)-1" '填入A2的公式
.Value = .Value
End With
End Sub
不用Excel工作表函數的VBA寫法
Sub sheet1_VBA()
Dim Arr, Brr, R&, S$
Arr = Range([A2], [B65536].End(3))
For R = 1 To UBound(Arr)
S = S & "," & Arr(R, 2)
Brr = Split(Mid(S, 2), ",")
Arr(R, 1) = UBound(Filter(Brr, Arr(R, 2)))
Next R
Range([A2], [B65536].End(3)) = Arr
End Sub
字典+陣列, 可解決很多基本需求, 可花些時間學習:
Sub sheet1_VCunt()
Dim Arr, i&, xD, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([Sheet1!B1], [Sheet1!B65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 1)
Arr(i - 1, 1) = Val(xD(T))
If T <> "" Then xD(T) = xD(T) + 1
Next i
[A2].Resize(UBound(Arr) - 1) = Arr
End Sub作者: ABK 時間: 2020-8-11 18:26