Hỏi cách viết VBA tạo số thứ tự

  • Thread starter Thread starter ST-Lu!
  • Ngày gửi Ngày gửi
Liên hệ QC

ST-Lu!

Love Wingchun
Tham gia
19/8/08
Bài viết
730
Được thích
546
Nghề nghiệp
Xích lô một thời
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
 
Lần chỉnh sửa cuối:
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.
 
Upvote 0
Upvote 0
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ỉ ?
 
Lần chỉnh sửa cuối:
Upvote 0
Đú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á.
 
Upvote 0
Đú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.
PHP:
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
 
Lần chỉnh sửa cuối:
Upvote 0
@ 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.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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!
 
Upvote 0
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 !
 
Upvote 0
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?
 
Upvote 0
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)
 

File đính kèm

Upvote 0
Tuyệt vời, cảm ơn boyxin nhé.
Tốc độ cải thiện rất nhiều.
 
Upvote 0
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é!
 
Upvote 0
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
 
Upvote 0
.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.
 
Lần chỉnh sửa cuối:
Upvote 0
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-
 
Upvote 0
Web KT

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

Back
Top Bottom