Đánh STT theo nhiều điều kiện

Thien · 2/10/07

Chào các bạn.

Mình đang gặp nhiều khó khăn trong việc đánh số thứ tự theo file đính kèm.
Sẽ có nhiều người nói mình sử dụng TK không hợp lý nhưng ở đây xin miễn bàn mà vui lòng giúp Tôi đánh số thứ tự theo quy luật sao:
- TK 5111, 5113, 3388, 331 nếu có số đuôi là 3C, CH, NH, CT thì sẽ đánh STT theo thứ tự từ trên xuống (44GS0607 : phần GS0607 sẽ thay đổi theo tháng).
- Các TK còn lại sẽ được đánh số thứ tự theo từng tài khoản.
(vui lòng xem qua file gửi kèm).

Hiện tại nếu dùng công thức thì Tôi đã phải sử dụng rất nhiều cột phụ để làm (Rất phi khoa học & dở).
Nếu dùng VBA thì đang không biết làm.

Mong các bạn giành ít thời gian giúp tôi, việc này đang rất cần mà khối lượng công việc lớn cần giải quyết gấp.

Chân thành cảm ơn.

Thân chào.

Trần Văn Bình · 12/10/07

Nhờ các anh chị giúp cho các hàm đánh số thứ tự. NHư tôi thường làm các hàm sau: =IF($B3"";MAX($A$3:A3)+1;"") hoặc =IF(SUBTOTAL(3;$B$3:$B$38)=COUNTA($B$3:$B$38);MAX($A$2:A2)+1;COUNTIF($F$2:F3;IF(F3"";F3;""))) ...vvNhưng trương hợp Tại cột A2 đánh I và đến cật A10 đánh II nó sẽ đánh số thứ tự từ 1-7 còn từ cột A11 trở đi lại bắt đầu từ 1 đến số nào đó khi chúng ta đánh mục tiếp theo.Với tôi nghĩ đây cũng là đánh số thứ tự có điều kiện Vậy không biết có phạm vào diễn dàn khôngXin chân thành cảm ơn

ThuNghi · 12/10/07

Bạn up file cái, chưa hiểu yêu cầu. Nên có phần muốn làm là thế nào.
To: Thien
Bạn chuyển thành Function CTMax2 của Mr OkeBab trong phần thực form.

Thien · 12/10/07

Dear Thunghi

vẫn sử dụng code cùa nvson đã giúp mình nhưng chỉnh lại 1 chút. Những dòng nào đã có STT thì thôi, còn những dòng trống thì đánh thứ tự như code của bạn son đã giúp mình.

Gấp quá. bạn thông cảm nha.

Thân chào.

ThuNghi · 12/10/07

Option Explicit

Public Sub DanhCT(dong1, dong2)
On Error Resume Next 'nvson
Dim i As Long, j As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For i = dong1 To dong2
If Cells(i, "B").Value <> Cells(i - 1, "B").Value Then
For j = i - 1 To 2 Step -1
If Cells(j, "B").Value = Cells(i, "B").Value Then Exit For
Next j
If Month(Cells(i, "A").Value) <> Month(Cells(j, "A").Value) Then
Cells(i, "D").Value = Cells(i, "B").Value & Right(Year(Cells(i, "A").Value), 2) & "/" & Month(Cells(i, "A").Value) & "/" & "001"
Else
Cells(i, "D").Value = Cells(i, "B").Value & Right(Year(Cells(i, "A").Value), 2) & "/" & Month(Cells(i, "A").Value) & "/" & Format(Val(Right(Cells(j, "D").Value, 3)) + 1, "000")
End If
ElseIf Cells(i, "A").Value = Cells(i - 1, "A").Value And Cells(i, "C").Value = Cells(i - 1, "C").Value Then
Cells(i, "D").Value = Cells(i - 1, "D").Value
ElseIf Month(Cells(i, "A").Value) <> Month(Cells(i - 1, "A").Value) Then
Cells(i, "D").Value = Cells(i, "B").Value & Right(Year(Cells(i, "A").Value), 2) & "/" & Month(Cells(i, "A").Value) & "/" & "001"
Else
Cells(i, "D").Value = Cells(i, "B").Value & Right(Year(Cells(i, "A").Value), 2) & "/" & Month(Cells(i, "A").Value) & "/" & Format(Val(Right(Cells(i - 1, "D").Value, 3)) + 1, "000")
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Bạn thêm sự kiện, nếu ngày thay đổi và lọai CT thay đổi tự động update số CT. Như vậy sẽ hay hơn,

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("A:C")) Is Nothing Then
If Not IsEmpty(Cells(Target.Row, "A").Value) And Not IsEmpty(Cells(Target.Row, "B").Value) And Not IsEmpty(Cells(Target.Row, "C").Value) Then '
Call DanhCT(Target.Row, Target.Row)
Else
Cells(Target.Row, "D").Value = ""
End If
End If
End Sub

Hay là bạn thêm đọan này vào

For i = dong1 To dong2
If Cells(i, "D").Value <> "" Then i = i + 1
If Cells(i, "B").Value <> Cells(i - 1, "B").Value Then

anhtuan1066 · 12/10/07

Với Trần Văn Bình: Nếu bạn đánh số thứ tự trong cột A thì tiêu chí gì đễ gõ các ký tự La Mã? Bạn phải nêu dc quy luật thì mới đánh số thứ tự dc... Còn ko thì post file lên, trong đó đã dc đánh số thứ tự bằng tay!
ANH TUẤN

Thien · 12/10/07

He he bạn không hiểu ý mình rùi.

Mã:

Public Sub DanhSTT_2()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim cell_i
Dim dem As Long, demD As Long, demM As Long, demQ As Long, demT As Long, demCTY As Long
Dim dem_i As Long, k As Long
For Each cell_i In Range("C5:C" & Range("C5536").End(xlUp).Row)
    Select Case UCase(cell_i)
        Case "5113D-3C", "5113D-CH"
            demD = demD + 1
            cell_i.Offset(0, -1).Value = demD & "D"
        Case "5113MB3C", "5113MBCH"
            demM = demM + 1
            cell_i.Offset(0, -1).Value = demM & "M"
        Case "5113QC-3C", "5113QC-CH"
            demQ = demQ + 1
            cell_i.Offset(0, -1).Value = demQ & "Q"
        Case "5113TKE3C", "5113TKECH"
            demT = demT + 1
            cell_i.Offset(0, -1).Value = demT & "T"
        Case "5111CTY", "33311CTY"
            demCTY = demCTY + 1
            cell_i.Offset(0, -1).Value = demCTY & "CTY"
            
        Case "333113C", "33311CH", "33311CTY"
            If UCase(cell_i.Offset(-1, 0)) = "5113D-3C" Or UCase(cell_i.Offset(-1, 0)) = "5113D-CH" Or UCase(cell_i.Offset(-1, 0)) = "5113MB3C" Or UCase(cell_i.Offset(-1, 0)) = "5113MBCH" Or UCase(cell_i.Offset(-1, 0)) = "5113QC-3C" Or UCase(cell_i.Offset(-1, 0)) = "5113QC-CH" Or UCase(cell_i.Offset(-1, 0)) = "5113TKE3C" Or UCase(cell_i.Offset(-1, 0)) = "5113TKECH" Then
                k = 1
                Do
                    k = k + 1
                Loop While UCase(cell_i.Offset(-k, 0).Value) = UCase(cell_i.Offset(-1, 0).Value)
                cell_i.Offset(0, -1).Value = cell_i.Offset(-k + 1, -1).Value
            Else
                If UCase(cell_i.Value) = UCase(cell_i.Offset(-1, 0).Value) Then
                    cell_i.Offset(0, -1).Value = Val(cell_i.Offset(-1, -1).Value) + 1 & Right(cell_i.Offset(-1, -1).Value, Len(cell_i.Offset(-1, -1).Value) - Len(CStr(Val(cell_i.Offset(-1, -1).Value))))
                End If
            End If
        Case ""
        Case Else
            dem = dem + 1
            cell_i.Offset(0, -1).Value = dem & "GS" & Format(Month(cell_i.Offset(0, -2).Value), "00") & Right(Year(cell_i.Offset(0, -2).Value), 2)
    End Select
Next cell_i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Vẫn giữ nguyên cách đánh STT như trên nhưng thêm 1 điều kiện nữa là những dòng nào đã có STT rùi thì thôi, còn chưa có thì đánh STT như code trên.
hiện tại mình đang không biết viết thêm đoạn code vô chỗ nào & đoạn code đó viết ra sao cũng chưa biết.

Bạn giúp nhé.

Thân.

PS: Mình học chậm quá, loai hoai từ sáng tời giờ vẫn chưa giải quyết được.Buồn quá.

nvson · 12/10/07

Bạn thử xem sao!

Mã:

Public Sub DanhSTT_2()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim cell_i
Dim dem As Long, demD As Long, demM As Long, demQ As Long, demT As Long, demCTY As Long
Dim dem_i As Long, k As Long
For Each cell_i In Range("C5:C" & Range("C5536").End(xlUp).Row)
[COLOR=red][B]    If IsEmpty(cell_i) Then
[/B][/COLOR]        Select Case UCase(cell_i)
            Case "5113D-3C", "5113D-CH"
                demD = demD + 1
                cell_i.Offset(0, -1).Value = demD & "D"
            Case "5113MB3C", "5113MBCH"
                demM = demM + 1
                cell_i.Offset(0, -1).Value = demM & "M"
            Case "5113QC-3C", "5113QC-CH"
                demQ = demQ + 1
                cell_i.Offset(0, -1).Value = demQ & "Q"
            Case "5113TKE3C", "5113TKECH"
                demT = demT + 1
                cell_i.Offset(0, -1).Value = demT & "T"
            Case "5111CTY", "33311CTY"
                demCTY = demCTY + 1
                cell_i.Offset(0, -1).Value = demCTY & "CTY"
                
            Case "333113C", "33311CH", "33311CTY"
                If UCase(cell_i.Offset(-1, 0)) = "5113D-3C" Or UCase(cell_i.Offset(-1, 0)) = "5113D-CH" Or UCase(cell_i.Offset(-1, 0)) = "5113MB3C" Or UCase(cell_i.Offset(-1, 0)) = "5113MBCH" Or UCase(cell_i.Offset(-1, 0)) = "5113QC-3C" Or UCase(cell_i.Offset(-1, 0)) = "5113QC-CH" Or UCase(cell_i.Offset(-1, 0)) = "5113TKE3C" Or UCase(cell_i.Offset(-1, 0)) = "5113TKECH" Then
                    k = 1
                    Do
                        k = k + 1
                    Loop While UCase(cell_i.Offset(-k, 0).Value) = UCase(cell_i.Offset(-1, 0).Value)
                    cell_i.Offset(0, -1).Value = cell_i.Offset(-k + 1, -1).Value
                Else
                    If UCase(cell_i.Value) = UCase(cell_i.Offset(-1, 0).Value) Then
                        cell_i.Offset(0, -1).Value = Val(cell_i.Offset(-1, -1).Value) + 1 & Right(cell_i.Offset(-1, -1).Value, Len(cell_i.Offset(-1, -1).Value) - Len(CStr(Val(cell_i.Offset(-1, -1).Value))))
                    End If
                End If
            Case ""
            Case Else
                dem = dem + 1
                cell_i.Offset(0, -1).Value = dem & "GS" & Format(Month(cell_i.Offset(0, -2).Value), "00") & Right(Year(cell_i.Offset(0, -2).Value), 2)
        End Select
[B][COLOR=red]    End If
[/COLOR][/B]Next cell_i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Thien · 12/10/07

Bạn son ơi sao nó không chạy được.

Thân.

ThuNghi · 12/10/07

For Each cell_i In Range("C5:C" & Range("C5536").End(xlUp).Row)
if cell_i.offset(0,??).value <>"" then Next cell_i

Do tôi không có file đó, ??? là cột có số CT.

Thien · 12/10/07

ThuNghi đã viết:
Do tôi không có file đó, ??? là cột có số CT.

Bạn xem qua file bài 28.

Thân.

nvson · 12/10/07

Bạn thay dòng này:

Mã:

If IsEmpty(cell_i) Then

bằng dòng này:

Mã:

If IsEmpty(cell_i.Offset(0, -1)) Then

Trần Văn Bình · 12/10/07

Vậy em phải làm phiền anh rồi

anhtuan1066 đã viết:
Với Trần Văn Bình: Nếu bạn đánh số thứ tự trong cột A thì tiêu chí gì đễ gõ các ký tự La Mã? Bạn phải nêu dc quy luật thì mới đánh số thứ tự dc... Còn ko thì post file lên, trong đó đã dc đánh số thứ tự bằng tay!
ANH TUẤN

Em gữi file đính kèm nhờ các bác giúp cho

anhtuan1066 · 12/10/07

Bạn xem STT như thế này đã hợp lý chưa nha!
ANH TUẤN

Thien · 13/10/07

Chào cả nhà.
Nếu dùng VBA sẽ không dùng đến cột phụ phải không anhtuan1066.
Anh làm hay nhưng mở nhiều cột phụ quá.

TC.

anhtuan1066 · 13/10/07

tôi nghĩ VBA chắc làm ngon lành... nhưng tùy bạn ấy thôi.. Với dử liệu của bạn ấy như thế thì tôi cũng nghĩ dc đến thế... hi.. hi.. Vả lại, quan trọng nhất là bạn ấy tiếp thu dc...
Tôi nghĩ vẩn có cách giãm bớt cột phụ đấy nhưng như thế thì quá vắn tắt, e rằng sẽ khó hiểu!
ANH TUẤN

Trần Văn Bình · 13/10/07

Có cách nào để không làm cột phụ

anhtuan1066 đã viết:
Bạn xem STT như thế này đã hợp lý chưa nha!
ANH TUẤN

Anh Tuấn ơi có cách nào để ko cần làm cột phụ được không anh
Em cảm ơn anh

anhtuan1066 · 13/10/07

Uh... nếu ko muốn cột phụ thì.. chìu bạn luôn.. nhưng mà công thức sẽ khá phức tạp đấy nhé! Với lại cái bảng chuyển số thành số La Mã thì vẫn phải có (tôi ko biết có hàm nào làm việc này trực tiếp ko)...
Bạn xem file nhé
ANH TUẤN

Trần Văn Bình · 13/10/07

Anh ơi vẩn còn cột phụ đấy.
Tại cột C chính là cột phụ đó anh "=IF(LEN(C4)<2;VLOOKUP(CODE(C4)-64;D2R;2;0);RIGHT(C4;LEN(C4)-2)*1)"

ThuNghi · 13/10/07

Bạn xem có đúng ý bạn không nhé! Không dùng cột nào phụ cả.
Chỉ mới có làm đến VIII, bạn tự triển khai tiếp.

anhtuan1066 · 13/10/07

Trời... cột C sao là cột phụ dc chứ... trong file rõ ràng bạn yêu cầu làm 2 cột B và C cơ mà...
Vậy bây giờ bạn muốn làm cột nào? Nói chính xác 1 lần thôi... Còn như file của ThuNghi chẳng hạn, tuy ko có cột phụ nhưng bạn cũng ko thể đánh số thêm nữa... Chỉ đánh dc đến IIIV là hết.. vậy bạn tính sao đây?

Đánh STT theo nhiều điều kiện

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

File đính kèm

GTVT

Hãy cho rồi sẽ nhận!

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

Hãy cho rồi sẽ nhận!

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

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

Geotechnics

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

File đính kèm

Hãy cho rồi sẽ nhận!

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

Geotechnics

GTVT

File đính kèm

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

File đính kèm

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

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

GTVT

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

File đính kèm

GTVT

Hãy cho rồi sẽ nhận!

File đính kèm

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

Đếm ngược thời gian