Chỉnh code tạo STT, nếu bảng tính kg có số liệu thì thóat, kg chạy code! (1 người xem)

Liên hệ QC

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

Hong.Van

Busy
Tham gia
7/5/12
Bài viết
2,330
Được thích
1,767
Em chào thầy cô & Anh chị!
Mã:
Sub STT()
On Error Resume Next
Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
    Rng = Range([B9], [B9].End(xlDown)).Resize(, [B8].End(xlToRight).Column).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
    For i = 1 To UBound(Rng, 1)
        If IsNumeric(Rng(i, 1)) Then
            N = N + 1: K = 0
            Arr(i, 1) = Application.WorksheetFunction.Roman(N)
        Else
            T = 0
            For J = 4 To UBound(Rng, 2)
                T = T + Rng(i, J)
            Next J
                If T > 0 Then
                    K = K + 1
                    Arr(i, 1) = K
                End If
        End If
    Next
[A9].Resize(i - 1).Value = Arr
End Sub
Code trên tạo Số thứ tự cho từ cell A9 trở xuống khi thỏa một số điều kiện.
Tại Sheet1, vì có số liệu nên code chạy OK

Tại Sheet2, vì không có số liệu nên code chạy tạo một dọc các chữ số La Mã
Yêu cầu: Nếu sheet kg có số liệu (như ở Sheet2) thì thóat khỏi Sub()
Em cảm ơn!
 

File đính kèm

Em chào thầy cô & Anh chị!
Mã:
Sub STT()
On Error Resume Next
Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
    Rng = Range([B9], [[COLOR=#ff0000]B9].End(xlDown)[/COLOR]).Resize(, [B8].End(xlToRight).Column).Value
ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
Code trên tạo Số thứ tự cho từ cell A9 trở xuống khi thỏa một số điều kiện.
Tại Sheet1, vì có số liệu nên code chạy OK

Tại Sheet2, vì không có số liệu nên code chạy tạo một dọc các chữ số La Mã
Yêu cầu: Nếu sheet kg có số liệu (như ở Sheet2) thì thóat khỏi Sub()
Em cảm ơn!

Sửa thành vầy xem:
Mã:
Sub STT()
  On Error Resume Next
  Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
  Rng = Range([B9], [COLOR=#ff0000][B50000].End(xlUp)[/COLOR]).Resize(, [B8].End(xlToRight).Column).Value
  [COLOR=#0000cd]If UBound(Rng) <= 2 Then Exit Sub[/COLOR]
  ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
  ......
  ......
 
Upvote 0
Sửa thành vầy xem:
Mã:
Sub STT()
  On Error Resume Next
  Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
  Rng = Range([B9], [COLOR=#ff0000][B50000].End(xlUp)[/COLOR]).Resize(, [B8].End(xlToRight).Column).Value
  [COLOR=#0000cd]If UBound(Rng) <= 2 Then Exit Sub[/COLOR]
  ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
  ......
  ......
Em đã thay code của thầy vào thì:
1/ Trường hợp Bảng tính kg có số liệu thì OK
2/ Nhưng chỉ có 2 hay 3 dòng số liệu thì không cho kết qủa
-----------
Trong File có 2 code
Sub STT_NDU() : là của Thầy (đã sửa)
Sub STT_Old() : là code cũ của em
Em cảm ơn!
 

File đính kèm

Upvote 0
Em đã thay code của thầy vào thì:
1/ Trường hợp Bảng tính kg có số liệu thì OK
2/ Nhưng chỉ có 2 hay 3 dòng số liệu thì không cho kết qủa
-----------
Trong File có 2 code
Sub STT_NDU() : là của Thầy (đã sửa)
Sub STT_Old() : là code cũ của em
Em cảm ơn!
Rắc rối nằm ở chổ xác định vùng dữ liệu ấy
Sửa thành vầy:
Mã:
Sub STT_NDU()
  Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
  [COLOR=#ff0000][B]Dim SrcRng As Range[/B][/COLOR]
  [B][COLOR=#ff0000]Set SrcRng = Range([B8], [B50000].End(xlUp))[/COLOR][/B]
  [COLOR=#ff0000][B]If SrcRng.Count = 1 Then Exit Sub[/B][/COLOR]
  [B][COLOR=#ff0000]Rng = Range([B9], [B50000].End(xlUp)).Resize(, [B8].End(xlToRight).Column).Value[/COLOR][/B]
.....
Chính bởi vì vậy mà khi viết code xử lý mảng, tôi rất ghét cái vu End(xlUp), End(xlDown)... chả được cái tích sự gì mà chỉ tổ.. gây rối
 
Upvote 0
Các Thầy & anh giúp em sao code không đánh số thứ tự ở những dòng chữ đỏ
Em xin mô tả lại nguyên tắc đánh số thứ tự lại như sau:

1/ Nếu bảng tính từ cột E đến cột M, không có số liệu thì thóat code

2/ Nếu cột B là dữ liệu kiểu Number thì đánh số thứ tự kiểu La Mã như I, II, III ... (Ví dụ như cell B9 và B95)

3/ Trong mỗi nhóm thì đánh STT 1,2,3 ... khi Tổng các dòng tương ứng Từ cột E đến cột M lớn hơn KHÔNG (ý em là nó có số liệu)

Em có làm ví dụ bằng cthức tại cột N (màu vàng)
---------------------
Trước đây, Số thứ tự kiểu La Mã dù dòng tương ứng có số liệu hay kg có thì vẫn đánh STT, Nếu có thể được thì sửa code giúp em là Nếu không có số liệu thì không đánh STT
Và đây code của em
Mã:
Sub STT()
On Error Resume Next
  Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
  Dim SrcRng As Range
  Set SrcRng = Range([B8], [B50000].End(xlUp))
  If SrcRng.Count = 1 Then Exit Sub
  Rng = Range([B9], [B50000].End(xlUp)).Resize(, [B8].End(xlToRight).Column).Value
  ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
    For i = 1 To UBound(Rng, 1)
        If IsNumeric(Rng(i, 1)) Then
            N = N + 1: K = 0
            Arr(i, 1) = Application.WorksheetFunction.Roman(N)
        Else
            T = 0
            For J = 4 To UBound(Rng, 2)
                T = T + Rng(i, J)
            Next J
                If T > 0 Then
                    K = K + 1
                    Arr(i, 1) = K
                End If
        End If
    Next
[A9].Resize(i - 1).Value = Arr
End Sub
Em cảm ơn!
 

File đính kèm

Upvote 0
Theo mình thì . . . .

(*) Trước tiên khoan hãy dùng câu lệnh
PHP:
 On Eror Resume Next
đi cái đã.

Chỉ khi biết chắc đó lỗi gì thì mới cần câu lệnh này;

(*) Kiểm tra các vùng mà bạn đang cần có dữ liệu

Cách thì NDU đã chỉ: Gán các vùng cần kiểm vô biến đối tượng kiểu Range & tìm hiểu kỹ về nó xem rỗng hay không, đạt iêu cầu hay không,. . .& . . .
 
Upvote 0
(*) Trước tiên khoan hãy dùng câu lệnh
PHP:
 On Eror Resume Next
đi cái đã.

Chỉ khi biết chắc đó lỗi gì thì mới cần câu lệnh này;

(*) Kiểm tra các vùng mà bạn đang cần có dữ liệu

Cách thì NDU đã chỉ: Gán các vùng cần kiểm vô biến đối tượng kiểu Range & tìm hiểu kỹ về nó xem rỗng hay không, đạt iêu cầu hay không,. . .& . . .

Đã bỏ
PHP:
 On Eror Resume Next
nhưng vẫn không thấy nó báo lỗi gì!
Code này do người khác viết giùm, nên em cũng kg hiểu lắm, Vậy em nhờ các thầy sửa giúp. Em cảm ơn!
 
Upvote 0
Các Thầy & anh giúp em sao code không đánh số thứ tự ở những dòng chữ đỏ
Em xin mô tả lại nguyên tắc đánh số thứ tự lại như sau:

1/ Nếu bảng tính từ cột E đến cột M, không có số liệu thì thóat code

2/ Nếu cột B là dữ liệu kiểu Number thì đánh số thứ tự kiểu La Mã như I, II, III ... (Ví dụ như cell B9 và B95)

3/ Trong mỗi nhóm thì đánh STT 1,2,3 ... khi Tổng các dòng tương ứng Từ cột E đến cột M lớn hơn KHÔNG (ý em là nó có số liệu)

Em có làm ví dụ bằng cthức tại cột N (màu vàng)
---------------------
Trước đây, Số thứ tự kiểu La Mã dù dòng tương ứng có số liệu hay kg có thì vẫn đánh STT, Nếu có thể được thì sửa code giúp em là Nếu không có số liệu thì không đánh STT
Và đây code của em
Mã:
Sub STT()
On Error Resume Next
  Dim Rng(), Arr(), i As Long, J As Long, K As Long, N As Long, T As Double
  Dim SrcRng As Range
  Set SrcRng = Range([B8], [B50000].End(xlUp))
  If SrcRng.Count = 1 Then Exit Sub
  Rng = Range([B9], [B50000].End(xlUp)).Resize(, [B8].End(xlToRight).Column).Value
  ReDim Arr(1 To UBound(Rng, 1), 1 To UBound(Rng, 2))
    For i = 1 To UBound(Rng, 1)
        If IsNumeric(Rng(i, 1)) Then
            N = N + 1: K = 0
            Arr(i, 1) = Application.WorksheetFunction.Roman(N)
        Else
            T = 0
            For J = 4 To UBound(Rng, 2)
                T = T + Rng(i, J)
            Next J
                If T > 0 Then
                    K = K + 1
                    Arr(i, 1) = K
                End If
        End If
    Next
[A9].Resize(i - 1).Value = Arr
End Sub
Em cảm ơn!
Tôi thấy bạn chỉ cần sửa cái này:
Rng = Range([B9], [B50000].End(xlUp)).Resize(, [B8].End(xlToRight).Column).Value
Thành:
Rng = Range([B9], [B50000].End(xlUp)).Resize(, 12).Value
Là xong chứ gì
------------
Ngoài lề chút: Tôi thấy các bạn đặt biến tùy tiện quá: Range là Range còn Array là Array ---> Những nhà lập trình chuyên nghiệp nếu nhìn tên biến Rng thì họ sẽ nghĩ ngay đây là Range. Vậy lý nào lại khai báo Dim Rng() thế chứ
Nếu là tôi thì sẽ khai báo biến Array thế này: Dim sArray hoặc Dim aSource hoậc arr_Src hoặc arr... vân vân mà chẳng bao giờ có cái chữ Rng trong đó cả
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom