Những bài tập VBA đơn giản dành cho những người mới bắt đầu

Liên hệ QC

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia
8/6/06
Bài viết
14,334
Được thích
22,377
Nghề nghiệp
Nuôi ba ba & trùn quế

Bài 01

Macro to merge values from one column into one cell and retain source formatting.
Example:

Source:
A1= "It is going to cost "
A2= "$1000.00" (A2 is formatted to underline value)

Destination: (desired result)
B2= "It is going to cost $1000.00" (A2 value is still underlined)

Đề bài có thể tóm gọn lại như sau:

Trên cột [A:A] ta có những dòng thuyết minh & dưới nó là những con số đã được định dạng bằng nhiều cách khác nhau để fân biệt như chữ in nghiên, chữ số được tô đậm hay Font có màu đỏ,. . . .

Macro có nhiệm vụ: Hễ dòng nào có số thì ô bên fải liền kề cần được mang nội dung cũa ô trên ô có số & bản thân số của ô đang xét; Mặt khác định dạng ô giống với ô mang số liệu

Chúc thành công
--=0
--=0

Bảng liệt kê:

TT | Tên bài | Tại | Diễn giải
01|Bài tập 01|#1|Nối chuỗi & định dạng
02|Bài tập 02 | #11|Thống kê số lần lặp
03|Bài tập 03|#19|Trích lọc danh sách theo năm
04|Bài tập 04|#27|Thêm dòng theo số liệu tháng - năm
05|Bài tập 05|#31|Tổng hợp số liệu hoạt động theo từng kỳ (tháng)
06|Bài tập 06|#73|Ghí chú ngày có chi fí lớn nhất trong từng tháng khảo sát
07|Bài tập 07|#84|Thêm dòng tính tổng, sau khi đã thống kê số liệu
08|Bài tập 08|#103|Kẻ dòng, viền khung & format báo cáo hoàn chỉnh
09| BT Fần B | #206 | (Ở đây có bảng liệt kê riêng)


Rất mong các bạn ủng hộ & hỗ trợ tối đa.

! --=0 --=0 --=0
 
Chỉnh sửa lần cuối bởi điều hành viên:
????????????????
Sao nóng tính quá vậy "em mình"?
Tôi đang nóng lòng muốn xem thêm các ví dụ của "em mình" mà.

Hôm qua cảm thấy nhiều người không đồng tình với mình, cũng có người cho rằng mình có ý định làm khó cho một ai đó, cũng có người nghĩ mình "sọt dưa" vào cái topic này nên cảm thấy bực bội tí.

Nhưng hôm nay, sau một giấc ngủ thì mọi việc đã quên hết rồi, chẳng bận tâm nữa, lại tiếp tục, lại vẫn là "độc thân, vui tính", chứ không thôi thành "độc thân, nóng tính" mất thôi!

Riêng với việc xóa hàng, tôi thừa nhận như Thầy NDU nói, cứ phang một phát từ trên xuống dưới là xong, không cần tủn mủn phải chọn vùng nào để xóa. Nhưng riêng với bài tập mình đưa lên đó thì mình không có lựa chọn nào khác phải dùng đến việc CLEARCONTENTS để dùng vào việc này mà không phải là COPY, không phải là SELECT hay thứ gì khác. MỤC ĐÍCH của mình khi dùng đến XÓA là để các bạn thấy được lỗi tiềm ẩn của phương thức END(xxx) như thế nào, với các hành động khác thì không cách nào các bạn nhận ra được cách hoạt động của END cả!

Cho nên tôi cố ép các bạn phải tự mình thử để thấy và rút ra kinh nghiệm là như vậy.

Tôi vẫn tiếp tục tham gia được chứ nhỉ?


Tôi không dám nói là tôi rành về cái này, nhưng bạn đừng cho rằng mình đã biết tất cả. Mà cho là bạn biết rồi sao lại hỏi tôi, có phải muốn bắt bẻ không? Ai cũng có thể biết Excel không hổ trợ ADO cho việc xóa dòng và xóa bảng, bạn hỏi tôi câu này nhằm mục đích gì? Có phải tôi là thành viên mới, chưa hiểu biết nhiều nên bạn muốn tôi gặp khó mà rút lui?


Bạn ơi, tôi nói bạn vẫn chưa hiểu hay sao ấy! Ý tôi muốn là ở môi trường nào thì chúng ta nên tuân thủ theo môi trường đó, học cũng nghiêm túc và chơi cũng nghiêm túc. Chúng ta đang học ngôn ngữ lập trình VBA cho người MỚI BẮT ĐẦU thì nói thiệt bản thân tôi cũng chỉ mới ngắm nghé ngôn ngữ ADO trong hơn 2 tháng nay thôi và 2 người chính hướng dẫn cho tôi là Hai Lúa Miền Tây và Anh Lê Văn Duyệt, ngoài hai anh này ra tôi còn tham khảo nhiều bài khác của các thành viên trên diễn đàn này. Cho nên tôi không thể vì tôi mới học ADO mà lại chuyển phần căn bản đó vào tại môi trường VBA của topic này được.
Trân trọng.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài tập nhỏ tiếp theo: Trong cột B, từ B4 đến B65535 có thể trống hoặc chữ, hoặc số, hãy đánh số thứ tự ở cột A theo các ô có chữ trong cột B. (Đối tượng: các "em" mới học VBA).
Nhà em nộp bài, với điều kiện cột B trống dưới 20 hàng
Sub SoTT()
r = 4
STT = TT
trong = 0
Do While trong < 20
If Cells(r, 2) <> "" Then
Cells(r, 1) = STT
STT = STT + 1
trong = 0
Else
Cells(r, 1) = ""
trong = trong + 1
End If
r = r + 1
Loop
End Sub
Hỏng rồi, bài nhà em cũng mắc lỗi theo Quanghai rồi,đánh số TT cả số ;
 
Lần chỉnh sửa cuối:
Upvote 0
Ôi Trời ơi, hay quá. Bái phục, bái phục
Nhưng:
Híc, híc, híc
Em cũng ráng thử phát nữa xem sao, nhiều bài mau lên sao với anh em chứ.
PHP:
Sub STT2()
Dim cell
   For Each cell In Range([B4], [B65536].End(3)).SpecialCells(2)
      If Not IsNumeric(cell) Then
         cell.Offset(, -1) = Application.Max([A:A]) + 1
      End If
   Next
End Sub
 
Upvote 0
Em cũng mới học, mò mãi không biết làm thế nào. Nhờ Record macro cũng ra được cái kết quả rồi edit lại tí cho đẹp. Up lên các bạn tham khảo cho vui.

PHP:
Sub STT()
   With Range([B4], [B65536].End(3)).SpecialCells(2)
      .Offset(, -1) = 1
      .Offset(, -1).DataSeries
   End With
End Sub
Em tet thử mà code xảy ra một lỗi là nếu ô B bắt đầu có dử liệu sau đó ô tiếp theo không có dử liệu thì số thứ tự điền toàn số 1 thôi.
1.jpg
 
Upvote 0
Em cũng ráng thử phát nữa xem sao, nhiều bài mau lên sao với anh em chứ.
PHP:
Sub STT2()
Dim cell
   For Each cell In Range([B4], [B65536].End(3)).SpecialCells(2)
      If Not IsNumeric(cell) Then
         cell.Offset(, -1) = Application.Max([A:A]) + 1
      End If
   Next
End Sub

Cái này mới gọi là đúng nha, cái trước là sai đó, vì có cách khoảng trong dữ liệu tại cột B mà!
 
Upvote 0
Bài tập nhỏ tiếp theo: Trong cột B, từ B4 đến B65535 có thể trống hoặc chữ, hoặc số, hãy đánh số thứ tự ở cột A theo các ô có chữ trong cột B. (Đối tượng: các "em" mới học VBA).

Em làm bài này như sau:

Mã:
Public Sub Xuan()
Dim Rng As Range, Cll As Range, K As Long
Set Rng = Range("B4:B65536")
For Each Cll In Rng
If Cll <> "" Then
K = K + 1
Cll.Offset(0, -1).Value = K
End If
Next
End Sub
 

File đính kèm

  • Baitapnho thanhlanh.xls
    31 KB · Đọc: 18
Lần chỉnh sửa cuối:
Upvote 0
Em làm bài này như sau:

Mã:
Public Sub Xuan()
Dim Rng As Range, Cll As Range, K As Long
Set Rng = Range("B4:B65536")
For Each Cll In Rng
If Cll <> "" Then
K = K + 1
Cll.Offset(0, -1).Value = K
End If
Next
End Sub

Giỏi lắm, tôi định hướng các bạn làm theo cách này đó! Các bạn không nhất thiết phải làm hàm MAX trong đây đâu!

Nhưng bạn cần chú ý, chọn vùng phải chọn lọc chứ đừng phang kiểu này nhé: Set Rng = Range("B4:B65536")

Mã:
Sub Test()
    Dim fCell As Range, n As Long
    For Each fCell In Range([B4], [B65536].End(3))
        If fCell.Value <> "" Then
            n = n + 1
            fCell.Offset(, -1) = n
        End If
    Next
End Sub

Nhưng nhớ sau này có ứng dụng như vậy thì nhớ BẪY LỖI ở hàng đầu tiên nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
Giỏi lắm, tôi định hướng các bạn làm theo cách này đó! Các bạn không nhất thiết phải làm hàm MAX trong đây đâu!

Nhưng bạn cần chú ý, chọn vùng phải chọn lọc chứ đừng phang kiểu này nhé: Set Rng = Range("B4:B65536")

Mã:
Sub Test()
    Dim fCell As Range, n As Long
    For Each fCell In Range([B4], [B65536].End(3))
        If fCell.Value <> "" Then
            n = n + 1
            fCell.Offset(, -1) = n
        End If
    Next
End Sub
Code bạn viết còn gặp 1 vấn đề là chạy code lần 1, khi xóa trống 1 vài cell nào đó ở cột B, chạy lại code, stt sẽ không đúng
 
Upvote 0
Thêm code nữa, cái nào trúng thì trúng. Đánh STT mà dùng For Each.. thì hơi xa xỉ hén
PHP:
Sub STT3()
With Range([B4], [B65536].End(3)).Offset(, -1)
   .Formula = "=IF(TYPE(B4)>1,MAX($A$3:A3)+1,"""")"
   .Value = .Value
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Code bạn viết còn gặp 1 vấn đề là chạy code lần 1, khi xóa trống 1 vài cell nào đó ở cột B, chạy lại code, stt sẽ không đúng

Nếu xóa 1 cell tại cột B, cần phải xóa cột STT sau đó chạy lại code, kết quả vẫn đúng bạn ạ. Cảm ơn sự góp ý của bạn, cần thêm dòng lệnh để code chạy "ngon lành" hơn chút nữa. Hic hic.
 
Lần chỉnh sửa cuối:
Upvote 0
Thêm code nữa, cái nào trúng thì trúng. Đánh STT mà dùng For Each.. thì hơi xa xỉ hén
PHP:
Sub STT3()
With Range([B4], [B65536].End(3)).Offset(, -1)
   .Formula = "=IF(TYPE(B4)>1,MAX($A$3:A3)+1,"""")"
   .Value = .Value
End With
End Sub
HI HI thêm một cách theo code của Quang Hải:
PHP:
Sub STT()
With Range([B4], [B65536].End(3)).Offset(, -1)  
 .Formula = "=IF(TYPE(B4)>1,SUBTOTAL(3,$B$4:B4),"""")"  
 .Value = .Value
End With
End Sub
 
Upvote 0
Code bạn viết còn gặp 1 vấn đề là chạy code lần 1, khi xóa trống 1 vài cell nào đó ở cột B, chạy lại code, stt sẽ không đúng

Không hề sai! Bạn nói hoàn toàn đúng, ngoài vấn đề xóa trắng cột trước, còn phải bẫy nhiều thứ khác! Cứ mạnh dạn thảo luận đi các bạn.
 
Upvote 0
Em sửa lại code như sau: Thêm Range("A4:A65536").ClearContents. Mỗi lần chạy code sẽ xóa cột STT trước rồi dựa theo cột B gán lại STT mới

Mã:
Public Sub Xuan()
Dim Rng As Range, Cll As Range, K As Long
Set Rng = Range("B4:B65536")
Range("A4:A65536").ClearContents
For Each Cll In Rng
If Cll <> "" Then
K = K + 1
Cll.Offset(0, -1).Value = K
End If
Next
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ví dụ tiếp theo :

Cho 1 dãy số nguyên từ A2 : A14. Viết code để tìm giá trị max, không dùng các hàm có sẵn trong excel.
 
Upvote 0
Nhưng em cũng mày mò sửa lại code như sau: Thêm Range("A4:A65536").ClearContents. Mỗi lần chạy code sẽ xóa cột STT trước rồi dựa theo cột B gán lại STT mới

Mã:
Public Sub Xuan()
Dim Rng As Range, Cll As Range, K As Long
Set Rng = Range("B4:B65536")
Range("A4:A65536").ClearContents
For Each Cll In Rng
If Cll <> "" Then
K = K + 1
Cll.Offset(0, -1).Value = K
End If
Next
End Sub
Sửa rồi mà không thay luôn

Set Rng = Range("B4:B65536")
Range("A4:A65536").ClearContents


Thành
Set Rng = Range("B4:B" & [B65536].End(3).Row)
Range("A4:A" & [A65536].End(3).Row).ClearContents
 
Upvote 0
Sửa rồi mà không thay luôn

Set Rng = Range("B4:B65536")
Range("A4:A65536").ClearContents


Thành
Set Rng = Range("B4:B" & [B65536].End(3).Row)
Range("A4:A" & [A65536].End(3).Row).ClearContents

Mình vẫn làm theo cách hiểu của mình trước đã, mình cần nắm vững cấu trúc ban đầu của các câu lệnh. Những góp ý của mọi người mình copy thành tài liệu chỉnh sửa bài tập riêng và nghiên cứu.
Với người mới học như mình, cần "nhai kỹ no lâu" với kiến thức ban đầu.
 
Lần chỉnh sửa cuối:
Upvote 0
Tip: Các khái niệm về Cell, Range, sheet...

Để cho các bạn mới tiếp cận mau chóng vấn đề tên gọi của các vấn đề liên quan đến sheet tôi khái quát một số mục như sau:

1) Sheet:

Tại một sheet mà chúng ta thấy, ngay chổ sheet tab là tên của sheet mà ta gọi là Sheet Name, nhưng với môi trường VBA nó có thêm một cái tên nữa ta gọi nó là Sheet Code (giống như ta có tên và một biệt danh vậy).

attachment.php


Vậy thì khi ta chọn sheet đó ta có thể dùng các cấu trúc sau:

Worksheets ("TenSheet").Select
Sheets("TenSheet").Select
Sheet1.Select

Như vậy đều đúng cả các bạn nhé! 2 mục trên là gọi tên <Sheet>.Name và mục đỏ gọi tên <Sheet>.CodeName các bạn nhé!

2) Range:

Với ô A1, thông thường ta viết Range("A1"), nhưng một cách khác ngắn gọn hơn ta viết [A1]

Nhưng theo tôi, khuyến khích các bạn dùng kiểu Range("A1") này hơn, bởi vì sau khi đặt dấu chấm (.) thì các List Constants sẽ được show ra để mình chọn lựa các thuộc tính, phương thức ... của nó.

3) Cells:

Ô A1 để gọi nó ta cũng có thể viết như Range, ngoài ra ta cũng còn viết theo cách khác đó là

Cells(1,1) với phương thức Cells(row,column) ta có thể điều chỉnh theo số hàng và cột để tìm địa chỉ tại ô đó.

Một số vấn đề liên quan như vậy, tôi mong các bạn hỏi thêm về các vấn đề liên quan đến mọi lĩnh vực trên sheet.
 

File đính kèm

  • Picture1.jpg
    Picture1.jpg
    39.9 KB · Đọc: 87
Upvote 0
Sửa rồi mà không thay luôn

Set Rng = Range("B4:B65536")
Range("A4:A65536").ClearContents


Thành
Set Rng = Range("B4:B" & [B65536].End(3).Row)
Range("A4:A" & [A65536].End(3).Row).ClearContents

Trưa nay không ăn cơm luôn. Đã nghiên cứu sửa bài tập thì thêm luôn bẫy lỗi cho "máu":
Đói quá, nên ăn VBA luôn cho đỡ đói.

Mã:
Public Sub Xuan()
Dim Rng As Range, Cll As Range, K As Long, Rs As Long
Rs = Range("B65536").End(xlUp).Row
If Rs > 3 Then
Set Rng = Range("B4:B" & Rs)
Rng.Offset(, -1).ClearContents
For Each Cll In Rng
If Cll <> "" Then
K = K + 1
Cll.Offset(0, -1).Value = K
End If
Next
Set Rng = Nothing
End If
End Sub
 
Upvote 0
Thêm code nữa, cái nào trúng thì trúng. Đánh STT mà dùng For Each.. thì hơi xa xỉ hén
PHP:
Sub STT3()
With Range([B4], [B65536].End(3)).Offset(, -1)
   .Formula = "=IF(TYPE(B4)>1,MAX($A$3:A3)+1,"""")"
   .Value = .Value
End With
End Sub

Cũng gần đúng ý mình, nhưng giả sử trong cột B có chứa các ô "'" hoặc " ", hoặc các ô số nhưng định dạng Text thì ... tèo!
Rất nguy hiểm khi lại dùng STT đó cho việc khác, ví dụ dùng cho hàm Vlookup.
Mà Quang Hải đâu phải người mới học VBA nhỉ? nhưng kệ coi như anh em mình bàn luận cho em út nó học, còn các cao thủ thì giám sát lại mình.
-----------------
Dùng vòng lặp không chỉ xa xỉ mà rất chậm, phải không?
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom