Hỏi cách viết VBA tạo số thứ tự (1 người xem)

[ST-Lu!]

Em đang học VBA và muốn làm một việc như sau

Chọn range("b1")
Nếu A1<>"" thì b1 =1 ' A1 khác rỗng
Bắt đầu b2
Nếu A2 = "" thì b2 = 1 ---> có nghĩa là (Ai = " " --> Bi = 1 " i <>1)

Đến khi nào gặp cột Ai <> "" thì Bi = 2

Cứ thế

Exit khỏi vòng lặp khi gặp dòng text cuối cùng...(có thể xác định dòng cuối bằng Cells(Cells.Rows.Count, 1).End(xlUp).Row



Mong các anh chỉ bảo

 

[ChanhTQ@]

Chỉ cần ba câu lệnh sau:

Option Explicit
Sub Macro1()
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
VietNam:    Selection.Offset(, 1) = 1
End Sub

Trong đó hết 2 câu nhờ bộ thu rồi!
Chú ý: con số 23, ta có thể thay số khác cho thích hợp với yêu cầu

 

[ST-Lu!]

Cám ơn ChănhTQ

Mình cần đánh số thứ tự mà
nếu ô bên trái (A1) khác rồng --> ô bên phải (B1) là 1
nếu ô dưới (A2...có thể là Ai) rỗng --- > B1...hay Bi cũng bằng 1 (bằng so với ở trên)

vòng lặp sẽ chạy theo Ai --> Ar (i=1)
r =Cells(Cells.Rows.Count, 1).End(xlUp).Row

nó chạy từ A1 đến khi nào gặp ô khác rỗng --> ổ bên phải B tương ứng = 2

---------------
ý mình là đánh số thứ tự đó mà

 

[boyxin]

Cám ơn ChănhTQ

Mình cần đánh số thứ tự mà
nếu ô bên trái (A1) khác rồng --> ô bên phải (B1) là 1
nếu ô dưới (A2...có thể là Ai) rỗng --- > B1...hay Bi cũng bằng 1 (bằng so với ở trên)

vòng lặp sẽ chạy theo Ai --> Ar (i=1)
r =Cells(Cells.Rows.Count, 1).End(xlUp).Row

nó chạy từ A1 đến khi nào gặp ô khác rỗng --> ổ bên phải B tương ứng = 2

---------------
ý mình là đánh số thứ tự đó mà

bạn thử chạy đoạn code này xem sao nhé

Sub Stt()
er = [a65535].End(xlUp).Row
Set rng = Range("A1:A" & er)
    k = 0
    For i = 1 To er
        If rng(i) <> "" Then
            k = k + 1
            Cells(i, 2) = k
        End If
    Next
End Sub

Hoặc là

Sub Stt()
er = [a65535].End(xlUp).Row
Set rng = Range("A1:A" & er)
    k = 0
    For i = 1 To er
        If rng(i) <> "" Then
            k = k + 1
            Cells(i, 2) = k
        Else
            Cells(i, 2)=Cells(i-1, 2)
       End If
    Next
End Sub

 

[ST-Lu!]

Ha ha...
Em hiểu rồi, mấu chốt ở chỗ cho k = 0 (để ghi vào bộ nhớ)--
---------
Em xin hỏi tí tẹo nữa. Bác nói sơ qua về set... giúp em với

Cám ơn bác

 

[tamhoncuada10313]

Theo mình hiểu lệnh set... là để gán cột A cho biến rng

 

[ndu96081631]

bạn thử chạy đoạn code này xem sao nhé

Sub Stt()
er = [a65535].End(xlUp).Row
Set rng = Range("A1:A" & er)
    k = 0
    For i = 1 To er
        If rng(i) <> "" Then
            k = k + 1
            Cells(i, 2) = k
        End If
    Next
End Sub

Hoặc là

Sub Stt()
er = [a65535].End(xlUp).Row
Set rng = Range("A1:A" & er)
    k = 0
    For i = 1 To er
        If rng(i) <> "" Then
            k = k + 1
            Cells(i, 2) = k
        Else
            Cells(i, 2)=Cells(i-1, 2)
       End If
    Next
End Sub

Ngắn 1 tí Boyxin ơi!

Sub Stt()
Er = [A65535].End(xlUp).Row
Set Rng = Range("A1:A" & Er)
    For Each Clls In Rng
      k = k - (Clls <> "")
      Clls.Offset(, 1) = k
    Next
End Sub

Tin chắc vẩn còn 1 cách khác nhanh hơn rất nhiều (về tốc độ)... Nhưng với dử liệu ít ta có thể tạm chấp nhận code này

 

[Po_Pikachu]

Có bác nào am hiểu "Đệ Quy" không? Có thể áp dụng làm cái này để em học hỏi được không? Nghe mấy bác làm mà sao khó hiểu quá! Thân.

 

[Lệnh Hồ Đại Hiệp]

Cám ơn ChănhTQ

Mình cần đánh số thứ tự mà
nếu ô bên trái (A1) khác rồng --> ô bên phải (B1) là 1
nếu ô dưới (A2...có thể là Ai) rỗng --- > B1...hay Bi cũng bằng 1 (bằng so với ở trên)

vòng lặp sẽ chạy theo Ai --> Ar (i=1)
r =Cells(Cells.Rows.Count, 1).End(xlUp).Row

nó chạy từ A1 đến khi nào gặp ô khác rỗng --> ổ bên phải B tương ứng = 2

---------------
ý mình là đánh số thứ tự đó mà

Tham khảo nhé : Lợi dụng hàm Excel :

Sub STT()
    With Sheet1
        With .Range("B2:B" & .Range("A65000").End(xlUp).Row)
            .FormulaR1C1 = "=IF(RC[-1]="""",R[-1]C,R[-1]C+1)"
            .Calculate
            .Value = .Value
        End With
    End With
End Sub

Chúc vui

 

[ndu96081631]

Có bác nào am hiểu "Đệ Quy" không? Có thể áp dụng làm cái này để em học hỏi được không?
Nghe mấy bác làm mà sao khó hiểu quá!
Thân.

Tôi cũng đang nghiên cứu về vấn đề này nhưng chưa "thông" lắm (chắc phải nhờ các đại cao thủ)
-----------------------------------------------------
Với bài toán trên, nếu dử liệu nhiều tôi sẽ phân tích như sau:
1> Cột A có 2 loại dử liệu (tạm gọi là vậy vì tôi không biết dùng từ chính xác) : Đó là những cell có dử liệu và các cell rổng
2> Nếu dùng vònglập theo cách thông thường, cột A có bao nhiêu cell thì vòng lập sẽ tốn bấy nhiêu lần quét---> Cụ thể trong file có 14 cell ==> Vòng lập tốn 14 lần duyệt
3> Nếu ta dùng phương thức SpecialCells duyệt qua các cell có dử liệu trước ---> Vị chi tốn 3 lần... Tiếp theo lại dùng phương thức SpecialCells duyệt qua các cell rổng ---> vị chi tốn 2 lần (mổi lần duyệt nguyên 1 Areas chứ không duyệt từng cell)
===> Với dử liệu trên, nếu tôi dùng SpecialCells thì chỉ tốn có 5 lần duyệt ===> Dử liệu càng lớn và số lượng cell rổng càng nhiều thì mới thấy được sự cải thiện về tốc độ...
Ví dụ: Dử liệu có 1000 dòng, trong đó có 100 cell có dử liệu và 900 cell rổng. Nếu dùng For theo cách thông thường thì tốn 1000 lần duyệt, còn như dùng SpecialCells (kết hợp thuộc tính Areas) thì tôi chỉ tốn có 100 + 99 = 199 lần duyệt ===> Tốc độ tăng ít nhất 5 lần ===> Đã không?
Các bạn thử xem!

 

[boyxin]

Đối với bài này: boyxin thì lại nghi như thế này có thể cải thiện tốc độ

Sub Macro4()
    Range(Cells(1), [A65535].End(xlUp)).Select
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Set Rng = Selection.SpecialCells(xlCellTypeVisible)
    For Each Clls In Rng
        k = k - (Clls <> "")
        Clls.Offset(, 1) = k 
    Next
    Selection.AutoFilter
End Sub

đã test với cột A với 50 000 dòng, vẫn chạy vèo vèo

 

[ndu96081631]

Đối với bài này: boyxin thì lại nghi như thế này có thể cải thiện tốc độ

Sub Macro4()
    Range(Cells(1), [A65535].End(xlUp)).Select
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Set Rng = Selection.SpecialCells(xlCellTypeVisible)
    For Each Clls In Rng
        k = k - (Clls <> "")
        Clls.Offset(, 1) = k 
    Next
    Selection.AutoFilter
End Sub

đã test với cột A với 50 000 dòng, vẫn chạy vèo vèo

Cái này là Boyxin chỉ điền STT vào các cell có dử liệu thôi, trong khi yêu cầu điền tất tần tật cơ mà...
Mà dù là điền STT vào các cell có dử liệu thì cũng đâu cần đến AutoFilter chứ
Vầy không được sao:

Sub Test()
   Dim Rng As Range, Clls As Range, k As Long
   Set Rng = Range("A1:A" & [A65536].End(xlUp).Row).SpecialCells(2, 23)
   For Each Clls In Rng
     Clls.Offset(, 1) = k + 1: k = k + 1
    Next
End Sub

Chạy có vèo vèo không?
Ẹc... Ẹc...
---------------------
Quay trở lại vấn đề, nếu buộc phải điền STT vào tất cả thì tôi vẩn dùng bao nhiêu đó số lần quét (giống như code trên)

Sub STT2()
  Dim Rng As Range
  Dim i As Long, k As Long
  With Range("A1:A" & [A65536].End(xlUp).Row)
     k = .SpecialCells(4).Areas.Count
     For i = 1 To k
       Set Rng = Union(.SpecialCells(2, 23).Areas(i), .SpecialCells(4).Areas(i))
       Rng.Offset(, 1).Value = i
     Next
  End With
  [A65536].End(xlUp).Offset(, 1) = k + 1
End Sub

Dù điền tất cả nhưng bảo đãm tốc độ vẩn bằng với code mà Boyxin đã nêu ở trên (chỉ điền STT ở các cell có dử liệu)

 

[ndu96081631]

Sao dòng 65536 có dữ liệu mà code không điền STT. ndu96081631 xem chưa? vì sao nhỉ?

Ai chà... câu hỏi hay... Ẹc... Ẹc...
Cùng lắm thì bạn IF 1 cái là xong chứ gì
Chẳng hạn:

Sub STT2()
  Dim Rng As Range, Src As Range
  Dim i As Long, k As Long
  If [A65536] = "" Then
    Set Src = Range("A1:A" & [A65536].End(xlUp).Row)
  Else
    Set Src = Range("A1:A65536")
  End If
  With Src
     k = .SpecialCells(4).Areas.Count
     For i = 1 To k
       Set Rng = Union(.SpecialCells(2, 23).Areas(i), .SpecialCells(4).Areas(i))
       Rng.Offset(, 1).Value = i
     Next
  End With
  Rng.End(xlDown).Offset(, 1) = k + 1
End Sub

Còn cách nào hay hơn nữa, các bạn cứ tiếp.... (Quan trọng vẩn là thuật toán)

 

[dphi_long60]

Hay quá. Cảm ơn boyxin
code của bác hay, nhưng nếu như sau khi chạy code, số TT tự đánh vào cột yêu cầu, thay vì mình ghi vào chữ số thì có thể ghi bằng công thức để khi có 1 hàng nào ở cột A bị xoá hoặc chèn thêm thì STT vẫn đúng.
Ví dụ như file này số TT động; nhưng mình không biết chạy macro.
Mong được chỉ giáo.
Thanks.

 

[boyxin]

Hay quá. Cảm ơn boyxin
code của bác hay, nhưng nếu như sau khi chạy code, số TT tự đánh vào cột yêu cầu, thay vì mình ghi vào chữ số thì có thể ghi bằng công thức để khi có 1 hàng nào ở cột A bị xoá hoặc chèn thêm thì STT vẫn đúng.
Ví dụ như file này số TT động; nhưng mình không biết chạy macro.
Mong được chỉ giáo.
Thanks.

Bạn xem thế này có được không?
​

 

[dphi_long60]

Cảm ơn boyxin, nhưng Bác boyxin ơi, ý mình không phải vậy. Nếu như vậy thì cũng như sau khi thay đổi mình chạy lại macro đánh STT; ý mình muốn là sau khi chạy macro thì cột STT có công thức (chỉ những hàng cột B có dữ liệu thôi nha) như trong file, như thế khi ta xoá một hàng dữ liệu cột B thì STT ở cột A thay đổi mà không phải chạy lại macro.
Mong được giúp đỡ.
Very Thanhks!

 

[TrungChinhs]

Cảm ơn boyxin, nhưng Bác boyxin ơi, ý mình không phải vậy. Nếu như vậy thì cũng như sau khi thay đổi mình chạy lại macro đánh STT; ý mình muốn là sau khi chạy macro thì cột STT có công thức (chỉ những hàng cột B có dữ liệu thôi nha) như trong file, như thế khi ta xoá một hàng dữ liệu cột B thì STT ở cột A thay đổi mà không phải chạy lại macro.
Mong được giúp đỡ.
Very Thanhks!

Sau khi thay đổi xong mới chạy lại macro đánh STT là cách tối ưu đó bạn. Theo ý của bạn thì phải bổ sung thêm code để mỗi khi ô hiện hành tại cột B thay đổi thì tự chạy lại macro ? nhìn thì hay thôi chứ khi làm việc với bảng tính lớn thì tốc độ chậm lắm đó. Ví dụ bạn định lấy một bộ ấm chén từ phòng này sang phòng khác thay vì 1 chuyến bạn cầm cả bộ thì mối chuyến bạn chỉ cầm 1 thứ tức là bạn phải mất thời gian gấp khoảng n lần.

 

[dphi_long60]

Không phải vậy, mình muốn sau khi thực hiện macro công thức đánh STT cột A vẫn còn thế thôi.

 

[TrungChinhs]

Nhưng cái này viết bằng VBA nên không có công thức, mỗi khi chạy macro là nó điền giá trị đã tính toán, còn nếu bạn muốn có công thức tại cột A thì code phải viết theo cách khác, nếu bạn cần thì mình sẽ quay lại bài này sau ít phút (đang dở kiếm bài)

 

[TrungChinhs]

Điền công thức đánh STT

Có phải thế này không ? Trong bài đánh STT tại cột D nếu bạn muốn đánh STT ở cột nào thì sửa lại code nhé (chỉ cần sửa D = tên cột mà bạn muốn là được)

 

[dphi_long60]

Có phải thế này không ? Trong bài đánh STT tại cột D nếu bạn muốn đánh STT ở cột nào thì sửa lại code nhé (chỉ cần sửa D = tên cột mà bạn muốn là được)

Đúng như thế này, nhưng nếu các dòng trống không có công thức thì chuyên nghiệp hơn bác Trung Chinh ơi.
Cảm ơn.

 

[ThuNghi]

Đúng như thế này, nhưng nếu các dòng trống không có công thức thì chuyên nghiệp hơn bác Trung Chinh ơi.
Cảm ơn.

Bạn xem code bạn ấy có dòng, bỏ dấu " ' " phía trước là thực thi lệnh

Clls.Value = Clls 'neu khong muon hien cong thuc thi xoa dau nhay " ' " truoc Cell

 

[TrungChinhs]

Nếu dòng trống không có công thức thì khi bạn nhập thêm dữ liệu vào dòng trống bạn lại phải nhấn lệnh để quét lại công thức để cho xuất hiện STT của dòng bạn vừa nhập có phải vậy không ? nếu vậy thì dùng cách của bạn Boyxin là OK rồi.

@ Bác ThuNghi nếu bỏ dấu nháy thì không còn công thức, muốn theo ý của bạn ấy có lẽ lại phải viết thêm đoạn xoá dữ liệu cho các dòng rỗng nhưng mà làm vậy để làm gì nhỉ ?

 

[dphi_long60]

Đúng đó, nếu như vậy thì dùng cách của boyxin rồi, có cách nào tạo được vòng lặp chạy chỉ quét các dòng có dữ liệu ở cột B và điền công thức STT ở cột A, để các dòng trống (không có dữ liệu thì không có công thức).
Dù sao cũng rất cảm ơn những đóng góp quý giá.

 

[ThuNghi]

Đúng đó, nếu như vậy thì dùng cách của boyxin rồi, có cách nào tạo được vòng lặp chạy chỉ quét các dòng có dữ liệu ở cột B và điền công thức STT ở cột A, để các dòng trống (không có dữ liệu thì không có công thức).
Dù sao cũng rất cảm ơn những đóng góp quý giá.

Bạn dùng sub này, stt sẽ đánh theo cột A căn cứ B.
Còn cần sẽ làm UDF.

Sub TaoSoTT()
Dim Rng As Range, iL As Long, eR As Long, MyRng As Range, lCount As Long
Sheet1.Select
[A4:A1000].ClearContents
eR = [B65000].End(xlUp).Row
Set MyRng = Range("B3:B" & eR)
Set Rng = MyRng(1)
lCount = WorksheetFunction.CountIf(MyRng, "<>" &"")
For iL = 1 To lCount
    With MyRng
        Set Rng = .Find(What:="*", After:=Rng, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        With Rng
            .Offset(0, -1) = iL
        End With
    End With
Next
End Sub

 

[TrungChinhs]

@ Bác ThuNghi sub của bác cũng chỉ đạt yêu cầu là hiện số thứ tự; ý bạn đó muốn là hiện cả công thức tại các dòng có dữ liệu (dòng không có dữ liệu thì không hiện gì cả) như File đính kèm

@ dphi_long60 đã sửa lại theo ý của bạn. Nếu không còn yêu cầu gì thêm thì nhấn nút trái tim nha.

 

[dphi_long60]

Bác Trung Chinh ơi, code đạt yêu cầu đề ra, nhưng có một vấn đề là nếu xử lý nhiều hàng dữ liệu thì thời gian chậm lắm. Không biết nguyên nhân, có cách nào khắc phục nhược điểm này không bác Trung Chinh nhỉ.
Very thanks!

 

[TrungChinhs]

Giải pháp tăng tốc cho sub ?

Chắc là có một ngàn lẻ một biện pháp giải quyết nhưng mình cũng không biết nhiều. Theo mình giải pháp cơ bản nhất chính là thuật giải của sub, bạn để ý trên diễn đàn sẽ thấy các cao thủ đều rất chú trọng giải quyết vấn đề tốc độ khi viết code (Tôi khuyên bạn dùng cách của Boyxin cũng vì lẽ đó) và người sử dụng phải sưu tầm chạy thử nhiều để biết code nào chạy nhanh hơn mà chọn, nhiều khi code viết dài hay ngắn không quan trọng mà quan trọng là xử lý nhanh hay chậm.

Đoạn code trong file đính kèm bài 26 (Tôi đã bổ sung đoạn code tăng tốc cho sub) là 1 giải pháp tương đối hữu hiệu, bạn dùng thử và chịu khó sưu tầm thêm để đưa ra kết luận nhé.

Chúc thành công !

 

[ndu96081631]

Quan điểm của tôi: Đã xài đến VBA thì nên dẹp luôn công thức và ngược lại<--- 2 thứ làm 1 lượt để tạo ra STT có phải là thừa quá không?

 

[boyxin]

Bác Trung Chinh ơi, code đạt yêu cầu đề ra, nhưng có một vấn đề là nếu xử lý nhiều hàng dữ liệu thì thời gian chậm lắm. Không biết nguyên nhân, có cách nào khắc phục nhược điểm này không bác Trung Chinh nhỉ.
Very thanks!

Bạn xem file này đã đạt yêu cầu chưa?
(Từ code của NDU, boyxin chỉnh sửa tý teo cho dạt yêu cầu bài toán)
​

 

[dphi_long60]

Tuyệt vời, cảm ơn boyxin nhé.
Tốc độ cải thiện rất nhiều.

 

[dphi_long60]

Làm ơn cho trót nhé.
Giữa 2 code không khác nhiều, một cái thì chạy chậm, còn cái kia chạy tốt?
boyxin có thể giải thích giùm được không?
Cảm ơn nhé!

 

[boyxin]

Làm ơn cho trót nhé.
Giữa 2 code không khác nhiều, một cái thì chạy chậm, còn cái kia chạy tốt?
boyxin có thể giải thích giùm được không?
Cảm ơn nhé!

1. Cái này phải hỏi các caco thủ trên GPE đi,
2. boyxin cũng mới tập tẹ nghiên nghiên cứu VBA thông qua record và hỏm lỏm code của mọi người trên 4rum này được mấy hôm
3. đa phần là record và chỉnh sửa chút xíu code của người khác để đạt yêu cầu công việc thôi

 

[Po_Pikachu]

.SpecialCells(2, 23) chính là yếu tố làm cho code nhanh đáng kể. Vì lệnh này nhằm làm cho vùng quét nhỏ đi: không lấy các giá trị rỗng mà chỉ lấy các ô có giá trị thôi. Bạn muốn thử thì dùng hai code này sẽ thấy có sự khác biết lớn. Range("B4:B" & [B65536].End(xlUp).Row).SpecialCells(2, 23).Select Range("B4:B" & [B65536].End(xlUp).Row).Select Một cái thì chỉ lấy những giá trị của cột B thôi, còn 1 cái là quét tất cả. Vậy cái nào ít hơn sẽ chạy nhanh hơn rồi! Bạn muốn tìm xem ở đâu hả? Bạn quét chọn cột B và nhấn F5, nhấn tiếp vào Special.. -> nhấp vào Constants -> OK thì sẽ thấy liền. Nếu bạn có Record New Macro thì sẽ được 1 dòng như sau: .SpecialCells(xlCellTypeConstants, 23).Select Và lệnh Constants ứng với vị trí thứ hai trong bảng Goto Special nên Boyxin đã gõ vào số 2 để thay cho xlCellTypeConstants. Bạn cứ thực hiện Record để học dần các lệnh. Chúc vui. Thân.

 

[hoangvuluan]

Xin chào!
Tôi dùng array thì có thể cải tiến tốc độ đáng kể, các bạn xem thử nhé:

Sub Stt2_boyxin()
Const CongThuc = "=IF(RC[1]=0,"""",COUNTA(R4C[1]:RC[1]))"
Dim Rng As Range, Clls As Range, k As Long
MsgBox Time ' 8:13:18
Range("A4:A" & [A65536].End(xlUp).Row + 1).ClearContents
Set Rng = Range("B4:B" & [B65536].End(xlUp).Row).SpecialCells(2, 23)
For Each Clls In Rng
Clls.Offset(, -1).FormulaR1C1 = k + 1
k = k + 1
Next
MsgBox Time ' 8:13:54 - xap xi 35 giay
End Sub


' giải pháp dùng array
Sub Stt2_boyxin2()
Dim ar(), t1, t2
Dim Rng As Range, Clls As Range, k As Long, ro As Long, ra1 As Range
MsgBox Time ' 8:10:45

Set Rng = Range("B4:B" & [B65536].End(xlUp).Row)
Set ra1 = Rng.Offset(, -1)
ro = Rng.Rows.Count
ReDim ar(ro)
ar = Rng
k = 1
' ''''''''' tao du lieu de test, sau khi tao thi dong thanh chu thich
' Randomize '
' For i = 1 To ro '
' If Int(1 + Rnd * i) Mod 2 Then '
' ar(i, 1) = k '
' k = k + 1 '
' End If '
' Next '
' Rng = ar '
' GoTo 1 ' da tao duoc 32394 o co chua du lieu de test
''''''
For i = 1 To ro
If Not IsEmpty(ar(i, 1)) Then
ar(i, 1) = k
k = k + 1
End If
Next
ra1 = ar
1:
MsgBox Time ' 8:10:54 - mat khoang 10 giay tren may co cau hinh manh
Set Rng = Nothing
Set ra1 = Nothing
End Sub


-hvl-