Kiểm tra sự liên tục của các số trong 1 cột.

thanhnhanubnd · 12/10/08

Nhờ các bạn xem :
Mình có cột A là cột số, các số này nhập thủ công . Ví dụ : 1,2,3,5,7.
Mình muốn viết 1 code kiểm tra sự liên tục của các số thứ tự.Như ví dụ trên : thì sẽ hiện ra thông báo " Còn thiếu số 4,6"
Thank.

thuongg · 12/10/08

Mìnnh nghĩ bạn nên tạo 1 cột giả AZ chẳng hạn, sau đó đánh số thứ tự của cột này AUTO
Rồi dùng (VBA cái này mình dốt lắm) lập trình để so sánh (VD: A1 với AZ1;.....) Nếu chúng khác thì MESS....Ý tuong la vay thoi

SA_DQ · 12/10/08

Bạn dùng thử cái con macro này

PHP:

Option Explicit
Sub SoLienTuc()
 Dim lRw As Long, Jf As Long, ZzZ As Long
 Dim StrC As String:       Const GPE As String = "GPE"
 
 lRw = Sheets("Sheet3").[A65500].End(xlUp).Row
 For Jf = 2 To lRw
   With Cells(Jf, "A")
      If .Offset(1) > .Value + 1 Then
         For ZzZ = .Value + 1 To .Offset(1) - 1
            StrC = StrC & ", " & CStr(ZzZ)
            MsgBox ZzZ & ": Chua Co", , GPE
         Next ZzZ
      End If
   End With
 Next Jf
 MsgBox "Con thieu cac so: " & Chr(10) & Mid(StrC, 3), , GPE
End Sub

$:=\+$

thanhnhanubnd · 12/10/08

Xin cám ơn bạn.File rất ok.Nghịch 1 tý, mình bỏ dòng code :

MsgBox ZzZ & ": Chua Co", , GPE
Cho nhanh.

Có 1 trường hợp khi số lượng số thiếu nhiều quá : ví dụ : 1,2.., 200,1000. thiếu từ 201 đến 999 thì tràn ra ngoài hộp thông báo.

SA_DQ · 12/10/08

thanhnhanubnd đã viết:
Xin cám ơn bạn.File rất ok.
Có 1 trường hợp khi số lượng số thiếu nhiều quá : ví dụ : 1,2.., 200,1000. thiếu từ 201 đến 999 thì tràn ra ngoài hộp thông báo.

Trong trường hợp nhiều quá những số chưa có, ta có thể giải quyết theo các hướng sau:
(Không căn cơ lắm): Bỏ bớt khoảng trống trong biến chuỗi
(Căn cơ hơn):
Thêm lệnh kiểm độ dài của chuỗi; Nếu vượt quá 1 độ dài nào đó thì:
* Hiện chuỗi
* Áp đặt chuỗi = "; " lại từ đầu
Mình nghỉ bạn sẽ làm được trong hôm nay; Nếu ngược lại mai sẽ có người giúp tiếp!

anhtuan1066 · 12/10/08

Đây là cách giãi bằng công thức... Có lẽ ko đúng lắm với ý bạn nhưng có thể tham khảo chơi...

phamduylong · 12/10/08

Sub SoLienTuc1 và SoLienTuc2 chỉ làm việc với vùng chọn 1 cột. Báo lỗi nếu số không xếp theo thứ tự tăng dần.

SoLienTuc1 báo bằng Msgbox như của bác Voda cho trường hợp ít số. SoLienTuc2 ghi kết quả vào ô bên phải.

Mã:

Sub SoLienTuc1()
Dim MyStr As String
Dim s1 As Double, s2 As Double
c = Selection.Column
If Selection.Column.Count > 1 Then
  MsgBox "Ban chon " & Selection.Column.Count & " cot !"
  Exit Sub
End If
rd = Selection.Row
rc = Selection.Rows.Count + rd - 1
s1 = Cells(rd, c)
For r = rd + 1 To rc
  s2 = Cells(r, c)
  If s2 <= s1 Then
    MsgBox "Day so khong xep theo thu tu tang dan !"
    Cells(r, c).Select
    Exit Sub
  ElseIf s2 > s1 + 1 Then
    If s2 = s1 + 2 Then
      MyStr = MyStr & s1 + 1 & ", "
    Else
      MyStr = MyStr & s1 + 1 & ":" & s2 - 1 & ", "
    End If
  End If
  s1 = s2
Next
If MyStr = "" Then
  MsgBox "So lien tuc"
Else
  MsgBox "Con thieu cac so: " & Left(MyStr, Len(MyStr) - 2)
End If
End Sub

Mã:

Sub SoLienTuc2()
Dim MyStr As String
Dim s1 As Double, s2 As Double
c = Selection.Column
If Selection.Columns.Count > 1 Then
  MsgBox "Ban chon " & Selection.Column.Count & " cot !"
  Exit Sub
End If
rd = Selection.Row
rc = Selection.Rows.Count + rd - 1
Range(Cells(rd, c + 1), Cells(rc, c + 1)).ClearContents
s1 = Cells(rd, c)
For r = rd + 1 To rc
  MyStr = ""
  s2 = Cells(r, c)
  If s2 <= s1 Then
    MsgBox "Day so khong xep theo thu tu tang dan !"
    Cells(r, c).Select
    Exit Sub
  ElseIf s2 > s1 + 1 Then
    For i = s1 + 1 To s2 - 1
      MyStr = MyStr & i & ", "
    Next
    Cells(r - 1, c + 1) = Left(MyStr, Len(MyStr) - 2)
  End If
  s1 = s2
Next
End Sub

hieuhaian · 13/10/08

thanhnhanubnd đã viết:
Nhờ các bạn xem :
Mình có cột A là cột số, các số này nhập thủ công . Ví dụ : 1,2,3,5,7.
Mình muốn viết 1 code kiểm tra sự liên tục của các số thứ tự.Như ví dụ trên : thì sẽ hiện ra thông báo " Còn thiếu số 4,6"
Thank.

Mình có thể thêm vào nội dung câu hỏi như thế này không : Các số được nhập không theo thú tự. VD: 2,1,3,4,7,9,8.
Nội dung yêu cầu thì vẫn giữ nguyên.
Cảm ơn nhiều!

ChanhTQ@ · 13/10/08

Mình thêm vào nội dung câu hỏi như thế này không : Các số được nhập không theo thú tự. VD: 2,1,3,4,7,9,8.. .

Vậy thì ta chép toàn bộ sang cột mới, đâu đó vào cột gần cuối, xếp lại & tìm như trên đã có;

Nếu không cho chép đi nơi mới mới là chuyện khó à nhe!
Lúc đó mình nghĩ, lại phãi tìm cực trị sau đó tiếp tục dùng vòng lặp;
Đấy chỉ là hướng tớ nghỉ ra vậy thôi; Xin mời các cao thủ cho ý kiến sáng suốt & tối ưu hơn! :-=

rollover79 · 14/10/08

ChanhTQ@ đã viết:
Vậy thì ta chép toàn bộ sang cột mới, đâu đó vào cột gần cuối, xếp lại & tìm như trên đã có;

Nếu không cho chép đi nơi mới mới là chuyện khó à nhe!
Lúc đó mình nghĩ, lại phãi tìm cực trị sau đó tiếp tục dùng vòng lặp;
Đấy chỉ là hướng tớ nghỉ ra vậy thôi; Xin mời các cao thủ cho ý kiến sáng suốt & tối ưu hơn!

Tôi không nghĩ nó phức tạp đến vậy, chỉ cần tìm ra Max của cột đó, 1 vòng For từ 1 đến số Max, For đến đâu thì tìm số đó trong vùng, không có là thiếu.

cadafi · 14/10/08

hieuhaian đã viết:
Mình có thể thêm vào nội dung câu hỏi như thế này không : Các số được nhập không theo thú tự. VD: 2,1,3,4,7,9,8.
Nội dung yêu cầu thì vẫn giữ nguyên.
Cảm ơn nhiều!

Bạn xem thử đoạn code này xem sao, có lẽ khá dài, nhưng khả năng mình chỉ đến đây:

PHP:

Sub LocDuLieu()
Dim MyList As Range, MaxData As Double, MinData As Double
Set MyList = Application.InputBox("Nhap cot can kiem tra vao day", Type:=8)
Application.ScreenUpdating = False
If IsNull(MyList) Or MyList Is Nothing Then
Exit Sub
Else
Sheets("Sheet1").[B:B].ClearContents
On Error Resume Next
Sheets.Add
''//Có thể thêm một chút vào đây để kiểm tra sự tồn tại của sheet("TEMP")
ActiveSheet.Name = "TEMP"    
With Sheets("TEMP")
MyList.Copy .[A1]
MaxData = Application.WorksheetFunction.Max(.[A:A])
MinData = Application.WorksheetFunction.Min(.[A:A])
For i = MinData To MaxData
.Range("B" & i - MinData + 1).Value = i
.Range("C" & i - MinData + 1).Value = "=IF(ISNA(VLOOKUP(B" & _
          (i - MinData + 1) & ",A:A,1,0)),B" & (i - MinData + 1) & ","""")"
Next i
.[C:C].Copy
.[C1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
.[C:C].SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
.Range("C1:C" & .[C65000].End(xlUp).Row).Copy Sheets("sheet1").[B2]
Sheets("sheet1").[B1].Value = "Cac so con thieu la:"
Sheets("Sheet1").Select
.Delete: Cancel = False
End With
End If
Application.ScreenUpdating = True
Set MyList = Nothing
End Sub

ChanhTQ@ · 14/10/08

rollover79 đã viết:
Tôi không nghĩ nó phức tạp đến vậy, chỉ cần tìm ra Max của cột đó, 1 vòng For từ 1 đến số Max, For đến đâu thì tìm số đó trong vùng, không có là thiếu.

Như bạn thì ta đã áp đặt cực tiểu là 1 rồi còn gì?!
Ý tôi muốn nói cực tiểu chưa chắc là 1, này nha:
* Tìm các số điện thoại của 1 tổng đài hay của 1 tỉnh, thành thì sao nào?
* Tìm cả chuỗi số có số âm thì sao?
Mình thấy trên diễn đàn, rằng viết Code cho đã đời, sau đó lại chưa đúng ý tác giả topic; Lại phải viết tiếp cái khác thay vào!

Kinh nghiệm bản thân, giải quyết trường hợp tổng quát trước thì hơn;
Không phải muốn phức tạp hóa vấn đề không đâu, có vậy người trả lời mới học được từ người hỏi và từ diễn đàn kia đó! --=--

phamduylong · 14/10/08

ChanhTQ@ đã viết:
Như bạn thì ta đã áp đặt cực tiểu là 1 rồi còn gì?!
Ý tôi muốn nói cực tiểu chưa chắc là 1, này nha:
* Tìm các số điện thoại của 1 tổng đài hay của 1 tỉnh, thành thì sao nào?
* Tìm cả chuỗi số có số âm thì sao?
Mình thấy trên diễn đàn, rằng viết Code cho đã đời, sau đó lại chưa đúng ý tác giả topic; Lại phải viết tiếp cái khác thay vào!

Kinh nghiệm bản thân, giải quyết trường hợp tổng quát trước thì hơn;
Không phải muốn phức tạp hóa vấn đề không đâu, có vậy người trả lời mới học được từ người hỏi và từ diễn đàn kia đó!

Để tổng quát hóa bài toán, theo tôi giải quyết theo hướng:
- Dãy số phải là số nguyên (âm, 0, dương)
- Số có sắp thứ tự hoặc không sắp thứ tự
- Các số nằm trong 1 cột

Tìm ra các số thiếu không khó. Nhưng cần phải thống nhất nhau cách xử lý kết quả:
- Dùng Msgbox không khả thi (chỉ áp dụng được với số thiếu ít) vì khi tắt Msgbox thì kết quả cũng mất luôn, không biết số nào để xử lý tiếp.
- Ghi thẳng kết quả vào bảng tính, nhưng ghi vào ô nào?
c1: Ghi vào ô bên phải của ô đầu tiên của 2 số không liên tục là khả thi nhất. Có thể nhìn vào đó chèn thêm ô để bổ sung số thiếu (số phải sắp thứ tự từ nhỏ đến lớn).

STT
| Số thiếu
|

1

| |

2

|3, 4|

5

|6, 7, 8, 9, 10|

11

| |

c2: Ghi vào cột bên phải của cột số từ trên xuống (số không cầnsắp thứ tự).

STT
| Số thiếu
|

5

|3, 4|

1

|6, 7, 8, 9, 10|

2

| |

11

| |

Từ bài giải chung, mỗi người tự vận dụng (viết lại code) cho cái riêng của mình

rollover79 · 14/10/08

ChanhTQ@ đã viết:
Như bạn thì ta đã áp đặt cực tiểu là 1 rồi còn gì?!
Ý tôi muốn nói cực tiểu chưa chắc là 1, này nha:

Biết cách tìm số Max không lẽ không có khả năng tìm số Min sao bạn???

quochung2005 · 14/10/08

số liên tục của bác SA_DQ rất hay nhưng nếu cho số lớn khoảng 47132 trở lên thì nó không được chính xác, nhưng số nhỏ hơn thì rất tốt

rollover79 · 14/10/08

quochung2005 đã viết:
số liên tục của bác SA_DQ rất hay nhưng nếu cho số lớn khoảng 47132 trở lên thì nó không được chính xác, nhưng số nhỏ hơn thì rất tốt

Bạn thử gửi 1 trường hợp cụ thể mà nó không đúng lên xem nào, tôi thấy nó vẫn đúng mà.

quochung2005 · 15/10/08

mình test lại rồi, các số điều chạy đúng, thanks bạn nhiều

SA_DQ · 15/10/08

Gởi tặng Ca_DaFi

Macro sẽ xử lý số liệu kiểu Long không trật tự tại cột 'A'
Những số thiếu sẽ ghi trên cột 'B' tại hàng là số lớn nhất, nhỏ hơn chúng vừa xuất hiện

PHP:

Option Explicit
Sub NoNums()
 Dim lRw As Long, Ww As Long, MinNum As Long, MaxNum As Long
 Dim minRng As Range, Rng As Range, tRng As Range
 Dim StrC As String
 
 Set Rng = Range([A2], [A65500].End(xlUp))
 Rng.Offset(, 1).Clear
 MinNum = Application.WorksheetFunction.Min(Rng)
 MaxNum = Application.WorksheetFunction.Max(Rng)
 Set minRng = Rng.Find(what:=MinNum, LookIn:=xlValues)
 For Ww = MinNum + 1 To MaxNum
   Set tRng = Rng.Find(what:=Ww, LookIn:=xlValues, lookAt:=xlWhole)
   If tRng Is Nothing Then
      StrC = StrC & "; " & Ww
   Else
      minRng.Offset(, 1) = Mid(StrC, 3)
      StrC = "":        Set minRng = tRng
   End If
 Next Ww
End Sub

cadafi · 15/10/08

HYen17 đã viết:

Macro sẽ xử lý số liệu kiểu Long không trật tự tại cột 'A'
Những số thiếu sẽ ghi trên cột 'B' tại hàng là số lớn nhất, nhỏ hơn chúng vừa xuất hiện

PHP:

Option Explicit
Sub NoNums()
 Dim lRw As Long, Ww As Long, MinNum As Long, MaxNum As Long
 Dim minRng As Range, Rng As Range, tRng As Range
 Dim StrC As String
 
 Set Rng = Range([A2], [A65500].End(xlUp))
 Rng.Offset(, 1).Clear
 MinNum = Application.WorksheetFunction.Min(Rng)
 MaxNum = Application.WorksheetFunction.Max(Rng)
 Set minRng = Rng.Find(what:=MinNum, LookIn:=xlValues)
 For Ww = MinNum + 1 To MaxNum
   Set tRng = Rng.Find(what:=Ww, LookIn:=xlValues, lookAt:=xlWhole)
   If tRng Is Nothing Then
      StrC = StrC & "; " & Ww
   Else
      minRng.Offset(, 1) = Mid(StrC, 3)
      StrC = "":        Set minRng = tRng
   End If
 Next Ww
End Sub

Quả thật, công cụ này:

Rng.Find(what:=MinNum, LookIn:=xlValues)

Thật sự mạnh, em học mà vẫn chưa thấm. Cảm ơn HYen17.
(Ps: Có thể mời bác một xị Bàu đá không?)

thanhnhanubnd · 18/3/09

Trích :
Option Explicit
Sub SoLienTuc()
Dim lRw As Long, Jf As Long, ZzZ As Long
Dim StrC As String: Const GPE As String = "GPE"

lRw = Sheets("Sheet3").[A65500].End(xlUp).Row
For Jf = 2 To lRw
With Cells(Jf, "A")
If .Offset(1) > .Value + 1 Then
For ZzZ = .Value + 1 To .Offset(1) - 1
StrC = StrC & ", " & CStr(ZzZ)
MsgBox ZzZ & ": Chua Co", , GPE
Next ZzZ
End If
End With
Next Jf
MsgBox "Con thieu cac so: " & Chr(10) & Mid(StrC, 3), , GPE
End Sub

1. Cho mình hỏi nếu trong cột A ta nhập nhầm ký tự không phải là số, ví dụ 7a chẳng hạn, thì làm sao để không báo lỗi và xem như số 7a này không tồn tại.
2. Có 1 yêu cầu thế này :

ví dụ ta cần kiểm tra sự liên tục từ A2 : a5.
a2 : 2
a3 : 5
a4 : 7
a5 : 9

Mình muốn sau khi kiểm tra hiện ra msgbox :
Từ số " min" đen so "max" còn thiếu ????(count) : số :.....

Theo ví dụ : "Tu so 2 đến số 9 còn thiếu 4 số : 3,4,6,8"
Thank

Kiểm tra sự liên tục của các số trong 1 cột.

Thành viên hoạt động

Thành viên chính thức

/(hông là gì!

File đính kèm

Thành viên hoạt động

/(hông là gì!

Thành viên gạo cội

File đính kèm

-

Thành viên mới

0901452không62

Thành viên tiêu biểu

Hành động từ trái tim

0901452không62

-

Thành viên tiêu biểu

Thành viên chính thức

Thành viên tiêu biểu

Thành viên chính thức

/(hông là gì!

Hành động từ trái tim

Thành viên hoạt động

Đếm ngược thời gian