Sorry, tôi viết mà không thử, bạn sửa lại chỗ này:
Sub LocDuyNhat()
Dim LastRow As Long, MaxRow As Long
''Tinh so hang lon nhat:
MaxRow = Rows.Count
With ActiveSheet ''<-- Co the thay bang ten sheet khac
''Loai bo AutoFilter:
.AutoFilterMode = False
''Tim hang cuoi:
LastRow = .Range("C" & MaxRow).End(xlUp)[COLOR=#ff0000][B].Row[/B][/COLOR]
''Neu hang cuoi nho hon hang tieu de thi thoat
If LastRow < 4 Then Exit Sub
Dim Nguon, KQ
Dim i As Long, k As Long
Dim Tmp1 As String, Tmp2 As String
Nguon = .Range("C4:D" & LastRow)
ReDim KQ(1 To MaxRow, 1 To 2)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Nguon)
Tmp1 = CStr(Nguon(i, 1))
Tmp2 = CStr(Nguon(i, 2))
''Ca 2 phai khac rong moi chap nhan:
If Tmp1 > "" And [B][COLOR=#ff0000]Tmp2 [/COLOR][/B]> "" Then
If Not .Exists(Tmp1) Then
.Add Tmp1, Empty
k = k + 1
KQ(k, 1) = Tmp1
KQ(k, 2) = Tmp2
End If
End If
Next i
End With
.Range("G4:H" & MaxRow).ClearContents
If k Then .Range("G4").Resize(k, 2) = KQ
End With
End SubAnh cũng có thể tự làm thí nghiệm mà. Khi kết thúc với End hay Exit Sub/ Function thì mọi biến sẽ được giải phóng, trừ các biến đặt ở ngoài Sub/ Function hoặc các biến là đối số được khai báo bởi ByRef hoặc biến được khai bởi Static.
Option Explicit
Dim T As Double
Sub TestTime1()
T = Timer
Dim Arr()
Arr = Sheet1.UsedRange.Value
Debug.Print Timer - T
End Sub
Sub TestTime2()
TestTime1
Debug.Print Timer - T
End Sub
Tôi thì không phải người giỏi chữ nghĩa nên chắc dùng từ ngữ ngô ngê chăng? Nếu có gì sai thì vui lòng chỉ bảo.
Application.ScreenUpdating=False
For i = 1 to 999
'nếu arr(i,4)=TRUE tức là hàng i đã tô màu thì next i
if not arr(i,4) then
for j=i+1 to 1000
'nếu arr(j,4)=TRUE tức là hàng j đã tô màu thì next j
if not arr(j,4) and arr(i,1)=arr(j,1) and arr(i,2)=arr(j,2) and arr(i,3)=arr(j,3) then
if not arr(i,4) then
'kiểm tra lại xem hàng i đã tô màu trong lần lặp với các giá trị j trước chưa
arr(i,4)=TRUE
Range("B" & i, "D" & i).Font.Color=-16776961
Range("B" & i, "D" & i).Font.Tintandshade=0
end if
arr(j,4)=TRUE
Range("B" & j, "D" & j).Font.Color=-16776961
Range("B" & j, "D" & j).Font.Tintandshade=0
end if
next j
end if
next i
Columns(5).delete
Application.ScreenUpdating=True
Private Sub Worksheet_Change(ByVal Target As Range) Dim rCel As Range, rFind As Range, rSrc As Range, rTarget As Range
On Error GoTo ExitSub
If Not Intersect(Range(
Chắc không phải tại dòng code không có tác dụng mà là code bị gì gì đó nên nó chạy tuốt xuống Exit Sub luôn rồi. Mà mình đọc sơ qua code thấy vướng vướng sao ấy.
Cảm ơn bạn đã giúp
[COLOR=#000000]Dim strCom As String
Dim objWMIService As Object[/COLOR]
[COLOR=#000000]Dim colAdapters As Object[/COLOR]
[COLOR=#000000]Dim objAdapter As Object[/COLOR]
[COLOR=#000000]strCom = "."[/COLOR]
[COLOR=#000000]Set objWMIService = GetObject _[/COLOR]
[COLOR=#000000]("winmgmts:" & "!\\" & strCom & "\root\cimv2")[/COLOR]
[COLOR=#000000]Set colAdapters = objWMIService.ExecQuery _[/COLOR]
[COLOR=#000000]("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")[/COLOR]
[COLOR=#000000]For Each objAdapter In colAdapters[/COLOR]
[COLOR=#000000]Sheets("login").Range("AB25") = objAdapter.MACAddress[/COLOR]
[COLOR=#000000][INDENT]Next objAdapter[/INDENT]
[/COLOR]
