Dùng hàm counta để đếm số thứ tự trong VBA (1 người xem)

Liên hệ QC

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

thierry henry

Thành viên mới
Tham gia
11/6/18
Bài viết
49
Được thích
4
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
 
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
Bạn có thể gửi dữ liệu đính kèm lên được không?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Em cảm ơn mọi người
Bài đã được tự động gộp:

Bạn có thể gửi dữ liệu đính kè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
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
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)
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
 
Upvote 0
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.
 
Upvote 0
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:P,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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:P,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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:

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:p,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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:p,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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:

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:p,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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:p,GHISO!I:I,PXK!B12,GHISO!A:A,""<=""&$C$3,GHISO!G:G,""NK"")-SUMIFS(GHISO!P: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
 
Upvote 0
Web KT

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

Back
Top Bottom