Đánh số thứ tự tự động (8 người xem)

huuthang_bd · 27/9/09

ndu96081631 đã viết:
Xem yêu cầu tại bài #4, tôi cải tiến thế này:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Clls As Range, k As Long If Not Intersect(Range("B2:B65536"), Target) Is Nothing Then Range([B65536].End(xlUp).Offset(1, 1), [C65536]).ClearContents For Each Clls In Target k = Evaluate("Max(C:C)") If Clls = "" Then Clls(, 2) = "" Else Clls(, 2) = k + 1 End If Next Clls End If End Sub

Các bạn test lại giùm! ---> Cho phép nhập nhầm có thể xóa sửa ---> Đương nhiên lúc này nhập sau sẽ có số TT lớn nhất

1. Người ta ủng hộ trước, do mình nhập sai, giờ mình sửa lại mà sửa luôn cho người ta nhập cuối cùng là không hợp lý.
2. Nhập nhầm 1 dòng nào đó, xóa đi thì số thứ tự không đánh lại, số thứ tự không liên tục mà bị khuyết số vừa xóa.

Thử code này. Muốn xóa, sửa, copy thế nào thì tùy.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Del As Boolean
    On Error Resume Next
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
        For Each Cll In Intersect(Target, [B:B])
        If Cll.Value <> "" Then
            If Cll.Offset(, 1).Value = "" Then Cll.Offset(, 1).Value = WorksheetFunction.Max([C:C]) + 1
        Else
            Cll.Offset(, 1).ClearContents
            Del = True
        End If
        Next
    If Del = True Then
        For Each Cl In [C2:C65536].SpecialCells(2)
            Cl.Value = WorksheetFunction.Rank(Cl.Value, [C:C], 1)
        Next
    End If
End Sub

ptlong04x1 · 27/9/09

ndu96081631 đã viết:
Vẫn cho phép xóa (xóa cột B thì cột C xóa theo)

Em thấy nếu mà xoá B --> Xoá C như vậy thì 1 lúc sau thì STT chạy loạn hết cả, 1,2,3 nhập trước mà bị xoá rồi thì STT chỉ toàn là 4,5,6 trở lên, đúng ra lúc này 4,5,6 ---> 1,2,3. Nếu người dùng mà nhập liệu rồi xoá tuỳ tiện thì nhức đầu đây.

logica · 27/9/09

ndu96081631 đã viết:
Như tôi nói ở trên: Sửa đồng nghĩa với nhập mới, STT sẽ thay đổi theo
Nếu bạn muốn STT này không đổi (tức đã có thỉ giũ nguyên) cũng làm được

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) .... End Sub

Vận cho phép xóa (xóa cột B thì cột C xóa theo)

cái này thì ok rồi!Tuy nhiên theo em thầy đã xóa thứ tự ở cột B & C thì điều chỉnh lại thứ tự trong cột C sẽ hoàn thiện hơn nữa!

ptlong04x1 · 27/9/09

huuthang_bd đã viết:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Del As Boolean
    On Error Resume Next
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
        For Each Cll In Intersect(Target, [B:B])
        If Cll.Value <> "" Then
            If Cll.Offset(, 1).Value = "" Then Cll.Offset(, 1).Value = WorksheetFunction.Max([C:C]) + 1
        Else
            Cll.Offset(, 1).ClearContents
            Del = True
        End If
        Next
    If Del = True Then
        For Each Cl In [C2:C65536].SpecialCells(2)
            Cl.Value = WorksheetFunction.Rank(Cl.Value, [C:C], 1)
        Next
    End If
End Sub

Mình thấy Code của huuthang_bd lần này là hoàn hảo nhất, tranh luận 1 hồi mình là người tham gia cũng thấy loạn hết cả óc, đến lúc tác giả vào lại topic chẳng biết bài để tải nữa. --=0

ndu96081631 · 27/9/09

huuthang_bd đã viết:
2. Nhập nhầm 1 dòng nào đó, xóa đi thì số thứ tự không đánh lại, số thứ tự không liên tục mà bị khuyết số vừa xóa.

cái vụ khuyết số ấy tôi nghĩ cũng không quan trọng mấy, cùng lắm là thêm vòng lập nữa thôi

PHP:

With Range([C2], [C65536].End(xlUp))
  For Each Clls In .SpecialCells(2)
    i = i + 1
    Clls = WorksheetFunction.Rank(Clls, .Cells, 1)
  Next
End With

tam8678 · 27/9/09

ndu96081631 đã viết:
Vẫn cho phép xóa (xóa cột B thì cột C xóa theo)

-------
Để ý chổ này chú NDU ơi

ndu96081631 · 27/9/09

tam8678 đã viết:
-------
Để ý chổ này chú NDU ơi

Em chưa hiểu ý anh?
Để ý gì vậy anh?
Chắc anh muốn nói đến việc xóa toàn bộ cột B ---> Code bị treo, đúng không?
Vụ này cũng hơi hiếm nhưng không phải là không xảy ra
Anh thêm đoạn này vào nữa là xong!

PHP:

If Range("B:B").SpecialCells(2) Is Nothing Then Exit Sub

Toàn bộ code như sau:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range, k As Long, i As Long
  On Error Resume Next
  If Not Intersect(Range("B2:B65536"), Target) Is Nothing Then
    If Range("B:B").SpecialCells(2) Is Nothing Then Exit Sub
    Range([B65536].End(xlUp).Offset(1, 1), [C65536]).ClearContents
    For Each Clls In Target
      k = Evaluate("Max(C:C)")
      If Clls = "" Then
        Clls(, 2) = ""
      ElseIf Clls(, 2) = "" Then
        Clls(, 2) = k + 1
      End If
    Next Clls
    With Range([C2], [C65536].End(xlUp))
      For Each Clls In .SpecialCells(2)
        i = i + 1
        Clls = WorksheetFunction.Rank(Clls, .Cells, 1)
      Next
    End With
  End If
End Sub

tam8678 · 27/9/09

ndu96081631 đã viết:
Em chưa hiểu ý anh?
Để ý gì vậy anh?

------
Bài này nôm na giống như danh sách tạm ứng lương của doanh nghiệp, DS có sẳn , điền số tiền của từng người vào không theo thứ tự.
Cách tốt nhất là cho phép xóa cột B nhưng không cho xóa cột C (để ít nhất khi nhìn vào để biết được rằng anh là người thứ mấy trong DS đã vào rồi lại ra => hết chối).

ndu96081631 · 27/9/09

tam8678 đã viết:
------
Bài này nôm na giống như danh sách tạm ứng lương của doanh nghiệp, DS có sẳn , điền số tiền của từng người vào không theo thứ tự.
Cách tốt nhất là cho phép xóa cột B nhưng không cho xóa cột C (để ít nhất khi nhìn vào để biết được rằng anh là người thứ mấy trong DS đã vào rồi lại ra => hết chối).

Đây là 1 yêu cầu riêng... hơi khác 1 chút
Nếu xóa cột B mà cột C vẫn giữ nguyên thì quá dể ---> Em nghĩ anh tự mình sửa được mà (xóa bớt code đi chứ khỏi cần thêm gì cả)

tam8678 · 27/9/09

ndu96081631 đã viết:
Đây là 1 yêu cầu riêng... hơi khác 1 chút
Nếu xóa cột B mà cột C vẫn giữ nguyên thì quá dể ---> Em nghĩ anh tự mình sửa được mà (xóa bớt code đi chứ khỏi cần thêm gì cả)

-----
Anh chỉ tham gia bài thôi, không có nhu cầu này, anh thì thực tế, xử lý đơn giản thôi ( làm tay quen rồi ).

huuthang_bd · 27/9/09

Suy nghĩ lại thấy bài này không thể dùng Rank để đánh số thứ tự lại. Ví dụ STT gồm 1, 2, 3, 4, 9, 8. Sau khi dùng Rank xếp lại sẽ được 1, 2, 3, 4, 6, 6. Tạm sửa lại như thế này

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Del As Boolean
    On Error Resume Next
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
        For Each Cll In Intersect(Target, [B:B])
        If Cll.Value <> "" Then
            If Cll.Offset(, 1).Value = "" Then Cll.Offset(, 1).Value = WorksheetFunction.Max([C:C]) + 1
        Else
            Cll.Offset(, 1).ClearContents
            Del = True
        End If
        Next
    If Del = True Then
        For Each Cl In [C2:C65536].SpecialCells(2)
            Cl.Value = Cl.Value + WorksheetFunction.Rank(Cl.Value, [C:C], 1) / 1000
        Next
        For Each Cl In [C2:C65536].SpecialCells(2)
            Cl.Value = Cl.Value * 1000 Mod 1000
        Next
    End If
End Sub

Dam Tran Van · 28/9/09

Anh gởi cho em bảng này em xem thử có đúng ý của em không?
(Trong bảng này nếu có tiền mà không có tên hoặc có tên mà không có tiền thì nó sẽ lơ không thèm đếm)

Nếu đúng cho anh xin lời cám ơn nhé.

logica · 28/9/09

Dam Tran Van đã viết:
Anh gởi cho em bảng này em xem thử có đúng ý của em không?
(Trong bảng này nếu có tiền mà không có tên hoặc có tên mà không có tiền thì nó sẽ lơ không thèm đếm)

Nếu đúng cho anh xin lời cám ơn nhé.

Bạn nên đọc kỹ yêu cầu trước khi post bài mới chứ!

Trần Văn Bình · 17/7/14

Đánh số thứ tự có điều kiện VBA

Tiện thể bào của các bạn cho mình hỏi luồn vì minh không biết VBA nên nhờ các bạn giúp cho có file đính kèm

Quang_Hải · 17/7/14

Trần Văn Bình đã viết:
Tiện thể bào của các bạn cho mình hỏi luồn vì minh không biết VBA nên nhờ các bạn giúp cho có file đính kèm

Chắc bạn cho rằng những thành viên trên diễn đàn là thần tiên nên có thể đọc được suy nghĩ của bạn. Nếu vậy thì bạn kiên nhẫn chờ nha.

Ngoai Thanh · 17/7/14

Trần Văn Bình đã viết:
Tiện thể bào của các bạn cho mình hỏi luồn vì minh không biết VBA nên nhờ các bạn giúp cho có file đính kèm

Bạn xem file đính kèm xem được chưa nhé !

To : Quang Hải :
Bạn ấy có yêu cầu ở comment mà .

Quang_Hải · 17/7/14

Ngoai Thanh đã viết:
Bạn xem file đính kèm xem được chưa nhé !

To : Quang Hải :
Bạn ấy có yêu cầu ở comment mà .

Cũng tinh mắt quá hén

***********************

Xin lỗi chủ bài viết của bài 34 nghen.

Ngoai Thanh · 18/7/14

quanghai1969 đã viết:
Cũng tinh mắt quá hén

***********************

Xin lỗi chủ bài viết của bài 34 nghen.

Thì mình cũng như bạn thôi, mình may hơn bạn là đặt chuột vào comment xem cái gì và tự nhiên thấy buồn cười : suýt ...

Đánh số thứ tự tự động (8 người xem)

Người dùng đang xem chủ đề này

Chuyên gia GPE

File đính kèm

Thành viên tích cực

Thành viên thường trực

Thành viên tích cực

Huyền thoại GPE

File đính kèm

Đời Xá Chi

Huyền thoại GPE

Đời Xá Chi

Huyền thoại GPE

Đời Xá Chi

Chuyên gia GPE

File đính kèm

Thành viên mới

File đính kèm

Thành viên thường trực

GTVT

File đính kèm

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

Cánh Diều xanh

File đính kèm

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

Cánh Diều xanh

Đếm ngược thời gian