Bạn thử.
[CODE]Sub ass()
Dim arr, kq, i As Long, max As Long, min As Long, dic As Object, a As Long
min = 1000000
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
arr = .Range("a2:A14").Value
For i = 1 To UBound(arr)
If min > arr(i, 1) Then min = arr(i, 1)
If max < arr(i, 1) Then max = arr(i, 1)
If Not dic.exists(arr(i, 1)) Then
dic.Add arr(i, 1), ""
End If
Next i
ReDim kq(1 To max - min, 1 To 1)
For i = min To max
If Not dic.exists(i) Then
a = a + 1
kq(a, 1) = i
End If
Next i
.Range("d2:D10000").ClearContents
If a Then .Range("d2").Resize(a).Value = kq
End With
End Sub[/CODE]
Bạn thử
Sub ass()
Dim arr, kq, i As Long, max As Long, min As Long, dic As Object, a As Long
min = 1000000
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
arr = .Range("a2:A14").Value
For i = 1 To UBound(arr)
If min > arr(i, 1) Then min = arr(i, 1)
If max < arr(i, 1) Then max = arr(i, 1)
If Not dic.exists(arr(i, 1)) Then
dic.Add arr(i, 1), ""
End If
Next i
ReDim kq(1 To max - min, 1 To 1)
For i = min To max
If Not dic.exists(i) Then
a = a + 1
kq(a, 1) = i
End If
Next i
.Range("d2:D10000").ClearContents
If a Then .Range("d2").Resize(a).Value = kq
End With
End SubThử không dùng Dic, dùng mảng sẽ nhanh hơn
Quen rồi, bị đít ám ảnh. Cứ cái gì liên quan đến "dò" là nghĩ ngay đến đít.
Sub test()
Dim lastRow As Long, k As Long, r As Long, curr_number As Long, curr_pos As Long, data(), result(), t
t = Timer
With ThisWorkbook.Worksheets("Sheet1")
.Range("E2:E" & Rows.Count).ClearContents
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow < 3 Then Exit Sub
data = .Range("A2:A" & lastRow).Value
End With
curr_number = data(1, 1)
curr_pos = 0
ReDim result(1 To data(UBound(data, 1), 1) - data(1, 1) + 1, 1 To 1)
For k = 2 To UBound(data, 1)
If curr_number + 1 < data(k, 1) Then
For r = curr_number + 1 To data(k, 1) - 1
curr_pos = curr_pos + 1
result(curr_pos, 1) = r
Next r
End If
curr_number = data(k, 1)
Next k
If curr_pos Then Sheet1.Range("E2").Resize(curr_pos).Value = result
MsgBox "batman1: " & Timer - t
End SubĐít thon, săn chắc thì ai cũng bị ám ảnh. Người chứ có phải tượng đá đâu bác.
Sub ABC()
Dim sArr(), Res()
Dim fN&, eN&, k&, r&, i&
With Sheets("Sheet1")
.Range("F2:F" & Rows.Count).ClearContents
i = .Cells(Rows.Count, "A").End(xlUp).Row
If i < 3 Then Exit Sub
sArr = .Range("A2:A" & i).Value
End With
fN = sArr(1, 1) + 1
eN = sArr(UBound(sArr), 1) - 1
r = 2
ReDim Res(1 To eN - fN + 3, 1 To 1)
For i = fN To eN
If i < sArr(r, 1) Then
k = k + 1
Res(k, 1) = i
Else
r = r + 1
End If
Next i
If k Then Sheet1.Range("F2").Resize(k).Value = Res
End SubChuẩn bác, nhất là diễn đàn này toàn mày râu không, nên thấy ham dit to dit nho ....... nhiều, đến mức họ ám ảnh luôn.
Xem code
Sub ABC()
Dim sArr(), Arr() As Boolean, Res()
Dim fN&, eN&, sR&, k&, i&
With Sheets("Sheet1")
i = .Cells(Rows.Count, "A").End(xlUp).Row
If i < 3 Then Exit Sub
sArr = .Range("A2:A" & i).Value
sR = UBound(sArr)
fN = Application.Min(sArr)
eN = Application.Max(sArr)
ReDim Arr(fN To eN)
ReDim Res(1 To eN - fN + 1, 1 To 1)
For i = 1 To sR
If sArr(i, 1) Then Arr(sArr(i, 1)) = True
Next i
For i = fN To eN
If Arr(i) = False Then
k = k + 1
Res(k, 1) = i
End If
Next i
.Range("F2:F" & Rows.Count).ClearContents
If k Then .Range("F2").Resize(k).Value = Res
End With
End Sub
Không hẳn như vậy. Ở đây trước sau gì cũng duyệt hết các con số. Cho nên tìm max/min trong lúc duyệt cũng được. Chỉ cần đặt cái mảng mapping lớn đủ để chứa.
