Dùng hàm counta để đếm số thứ tự trong VBA

thierry henry · 14/8/21

Chào mọi người , trong 1 bảng tính excel thông thường để đếm số thứ tự chúng ta dùng A12 =IF(B12="","",COUNTA($B$12:B12)) sau đó tại A12 ta nhấn CTRL và kéo chuột đến A50 để copy công thức . Khi B12 có DL thì A12 sẽ đếm , Khi B12="" hay DL bị xóa thì A12 = "" . Bây giờ em chuyển nó thành code VBA thì nó thành :
Sub ABC()
If sheet1.Range("B12").Value = "" Then
sheet1.Range("A12").Value = ""
Else: sheet1.Range("A12").Value = Application.WorksheetFunction.CountA(sheet1.Range("$B$12:B12"))
End If
End Sub
Nhưng nếu cứ lặp lại đoạn code đó tới mấy chục lần từ B12 tới B50 , A12 tới A thì vừa rối , dễ sai sót mà nặng file . Còn dùng array và for....next cho nó thì em chưa rành . Các cao nhân chỉ giùm

Hoàng Nhật Phương · 14/8/21

thierry henry đã viết:
Chào mọi người , trong 1 bảng tính excel thông thường để đếm số thứ tự chúng ta dùng A12 =IF(B12="","",COUNTA($B$12:B12)) sau đó tại A12 ta nhấn CTRL và kéo chuột đến A50 để copy công thức . Khi B12 có DL thì A12 sẽ đếm , Khi B12="" hay DL bị xóa thì A12 = "" . Bây giờ em chuyển nó thành code VBA thì nó thành :
Sub ABC()
If sheet1.Range("B12").Value = "" Then
sheet1.Range("A12").Value = ""
Else: sheet1.Range("A12").Value = Application.WorksheetFunction.CountA(sheet1.Range("$B$12:B12"))
End If
End Sub
Nhưng nếu cứ lặp lại đoạn code đó tới mấy chục lần từ B12 tới B50 , A12 tới A thì vừa rối , dễ sai sót mà nặng file . Còn dùng array và for....next cho nó thì em chưa rành . Các cao nhân chỉ giùm

Bạn có thể gửi dữ liệu đính kèm lên được không?

quanluu · 14/8/21

Bạn học code VBA thì bạn phải biết dùng biến và các câu lệnh cơ bản như: if, for chứ.
Bạn có thể làm đơn giản là
for i = 12 to 50
đưa code của bạn vào đây thay số 12 bằng i, riêng $B$12 giữ nguyên. vd: "A12" thay bằng "A" & i
next

qtm1987 · 14/8/21

Nếu muốn chi tiết code thì như sau, bạn xem lại lý thuyết for, if rồi vận dụng.

Mã:

'dem stt dung mang
Sub ABC()
    Dim sArray, Arr()
    Dim i As Integer, k As Integer, u As Integer, tst As Integer
    With Sheet1
        .Range("A12:A10000").ClearContents
        tst = .Range("B" & Rows.Count).End(xlUp).Row
        If tst < 13 Then Exit Sub 'nap vao mang phai toi thieu du lieu phai tu 2 hang tro len, neu chi 1 hang hoac khong co hang nao se loi
        sArray = .Range([B12], [B10000].End(xlUp)).Value
        u = UBound(sArray, 1)
        ReDim Arr(1 To u, 1 To 1)
        For i = 1 To u
            If Not IsEmpty(sArray(i, 1)) Then
                k = k + 1
                Arr(i, 1) = k
            End If
        Next        
        .Range("A12").Resize(i - 1, 1) = Arr
    End With
End Sub

'dem so thu tu truc tiep tren range bang tinh
Sub XYZ()
    Dim i As Integer, k As Integer
    With Sheet1
        For i = 1 To 50
            If .Range("B" & i + 11) <> "" Then
                k = k + 1
                .Range("A" & i + 11) = k
            End If
        Next
    End With
End Sub

thierry henry · 14/8/21

Em cảm ơn mọi người

Bài đã được tự động gộp: 14/8/21

Hoàng Nhật Phương đã viết:
Bạn có thể gửi dữ liệu đính kèm lên được không?

Cảm ơn bạn nhé mình đã viết như thế này sau khi tham khảo ý kiến mọi người :

Option Explicit

Sub ABC()
Dim i As Integer
For i = 12 To 50
If Sheet1.Range("B" & i).Value = "" Then
Sheet1.Range("A" & i).Value = ""
Else: Sheet1.Range("A" & i).Value = Application.WorksheetFunction.CountA(Sheet1.Range("$B$12:B" & i))
End If
Next i
End Sub

Đồng thời sheet1 , mình viết :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 12 To 50
If Not Application.Intersect(Sheet1.Range("B" & i), Target) Is Nothing Then
Call ABC
End If
Next i
End Sub

thierry henry · 14/8/21

Mà mọi người cho mình hỏi tiếp là viết thế này Sheet1.Range("B" & i) máy nó hiểu . nhưng trong trường hợp Sheet1.Range("C12: H12" ) viết thành Sheet1.Range("C:H" & i) thì máy lại không hiểu nên bắt lỗi . Mọi người giúp mình với

Ba Tê · 14/8/21

thierry henry đã viết:
Mà mọi người cho mình hỏi tiếp là viết thế này Sheet1.Range("B" & i) máy nó hiểu . nhưng trong trường hợp Sheet1.Range("C12: H12" ) viết thành Sheet1.Range("C:H" & i) thì máy lại không hiểu nên bắt lỗi . Mọi người giúp mình với

Phải viết là Sheet1.Range("C" & i & ":H" &i)

thierry henry đã viết:
Nhưng nếu cứ lặp lại đoạn code đó tới mấy chục lần từ B12 tới B50

Như bài #1 thì chỉ cần 1 câu lệnh:

PHP:

Public Sub Gpe()
    Range("A12:A50").FormulaR1C1 = "=If(RC[1]="""","""",CountA(R12C[1]:RC[1]))"
End Sub

thierry henry · 14/8/21

Ba Tê đã viết:
Phải viết là Sheet1.Range("C" & i & ":H" &i)

Như bài #1 thì chỉ cần 1 câu lệnh:

PHP:

Public Sub Gpe() Range("A12:A50").FormulaR1C1 = "=If(RC[1]="""","""",CountA(R12C[1]:RC[1]))" End Sub

Mình cảm ơn bạn nhé

quanluu · 15/8/21

Ba Tê đã viết:
Phải viết là Sheet1.Range("C" & i & ":H" &i)

Như bài #1 thì chỉ cần 1 câu lệnh:

PHP:

Public Sub Gpe() Range("A12:A50").FormulaR1C1 = "=If(RC[1]="""","""",CountA(R12C[1]:RC[1]))" End Sub

Cái này là điền công thức rồi bạn, chắc phải thêm 1 dòng nữa để chuyển thành value.

thierry henry · 16/8/21

Ba Tê đã viết:
Phải viết là Sheet1.Range("C" & i & ":H" &i)

Như bài #1 thì chỉ cần 1 câu lệnh:

PHP:

Public Sub Gpe() Range("A12:A50").FormulaR1C1 = "=If(RC[1]="""","""",CountA(R12C[1]:RC[1]))" End Sub

Bác ơi ! em vừa viết đoạn code sau :
Sub ABC()

If sheet1.Range("B12").Value = "" Then

Sheet1.Range("I12").Value = ""

Else: sheet1.Range("I12").Value = "=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I12").Value = sheet1.Range("I12").Value

End If

End Sub

Nếu viết cho một lúc mấy chục dòng thì :
Sub ABC ()
Application.ScreenUpdating = False
Dim i As Integer
For i = 12 To 50
If sheet1.Range("B" & i ).Value = "" Then

Sheet1.Range("I" & i).Value = ""

Else: sheet1.Range("I" & i ).Value =
"=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I" & i ).Value = sheet1.Range("I" & i ).Value
Application.ScreenUpdating = True
End If
Next i
End Sub

Mấy chữ B12 phải sửa lại như thế nào ạ ? Bác chỉ giúp em

Bài đã được tự động gộp: 16/8/21

quanluu đã viết:
Cái này là điền công thức rồi bạn, chắc phải thêm 1 dòng nữa để chuyển thành value.

Bác ơi ! em vừa viết đoạn code sau :
Sub ABC()

If sheet1.Range("B12").Value = "" Then

Sheet1.Range("I12").Value = ""

Else: sheet1.Range("I12").Value = "=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I12").Value = sheet1.Range("I12").Value

End If

End Sub

Nếu viết cho một lúc mấy chục dòng thì :
Sub ABC ()
Application.ScreenUpdating = False
Dim i As Integer
For i = 12 To 50
If sheet1.Range("B" & i ).Value = "" Then

Sheet1.Range("I" & i).Value = ""

Else: sheet1.Range("I" & i ).Value =
"=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I" & i ).Value = sheet1.Range("I" & i ).Value
Application.ScreenUpdating = True
End If
Next i
End Sub

Mấy chữ B12 phải sửa lại như thế nào ạ ? Bác chỉ giúp em

Bài đã được tự động gộp: 16/8/21

qtm1987 đã viết:

Nếu muốn chi tiết code thì như sau, bạn xem lại lý thuyết for, if rồi vận dụng.

Mã:

'dem stt dung mang
Sub ABC()
    Dim sArray, Arr()
    Dim i As Integer, k As Integer, u As Integer, tst As Integer
    With Sheet1
        .Range("A12:A10000").ClearContents
        tst = .Range("B" & Rows.Count).End(xlUp).Row
        If tst < 13 Then Exit Sub 'nap vao mang phai toi thieu du lieu phai tu 2 hang tro len, neu chi 1 hang hoac khong co hang nao se loi
        sArray = .Range([B12], [B10000].End(xlUp)).Value
        u = UBound(sArray, 1)
        ReDim Arr(1 To u, 1 To 1)
        For i = 1 To u
            If Not IsEmpty(sArray(i, 1)) Then
                k = k + 1
                Arr(i, 1) = k
            End If
        Next       
        .Range("A12").Resize(i - 1, 1) = Arr
    End With
End Sub

'dem so thu tu truc tiep tren range bang tinh
Sub XYZ()
    Dim i As Integer, k As Integer
    With Sheet1
        For i = 1 To 50
            If .Range("B" & i + 11) <> "" Then
                k = k + 1
                .Range("A" & i + 11) = k
            End If
        Next
    End With
End Sub

Bác ơi ! em vừa viết đoạn code sau :
Sub ABC()

If sheet1.Range("B12").Value = "" Then

Sheet1.Range("I12").Value = ""

Else: sheet1.Range("I12").Value = "=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I12").Value = sheet1.Range("I12").Value

End If

End Sub

Nếu viết cho một lúc mấy chục dòng thì :
Sub ABC ()
Application.ScreenUpdating = False
Dim i As Integer
For i = 12 To 50
If sheet1.Range("B" & i ).Value = "" Then

Sheet1.Range("I" & i).Value = ""

Else: sheet1.Range("I" & i ).Value =
"=IFERROR(VLOOKUP(B12,DMHANGHOA,9,0)+SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P

,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""XK""),"""")"

sheet1.Range("I" & i ).Value = sheet1.Range("I" & i ).Value
Application.ScreenUpdating = True
End If
Next i
End Sub

Mấy chữ B12 phải sửa lại như thế nào ạ ? Bác chỉ giúp em

Dùng hàm counta để đếm số thứ tự trong VBA

thierry henry

Thành viên mới

Hoàng Nhật Phương

Thành viên gắn bó

quanluu

Thành viên gắn bó

qtm1987

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

thierry henry

Thành viên mới

thierry henry

Thành viên mới

Ba Tê

Cạo Rồi Khỏi Gội

thierry henry

Thành viên mới

quanluu

Thành viên gắn bó

thierry henry

Thành viên mới

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng