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

SA_DQ · 27/11/12

Bài 01

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

ndu96081631 · 4/12/12

Hoàng Trọng Nghĩa đã viết:
Thầy ơi, đây chẳng là gì cả, đơn giản là một bài thực hành, giống như Bài làm thêm trong việc học mà thôi. Dùng xóa để đơn giản chứ biết đâu không phải là xóa mà là một thứ gì khác, copy paste chẳng hạn, sẽ làm sao xác định cho chính xác vùng và địa chỉ thật sự đây?

Đương nhiên tôi thừa hiểu "ý đồ" của Nghĩa trong bài toán này... nhưng dù sao thì Nghĩa cũng phải đưa bài toán cho thực tế hơn một chút ---> Ai rảnh đâu mà nghĩ cái chuyện không thực tế kia chứ (đã quét dọn còn định vị cóc khô gì cho mệt)
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 4/12/12

ndu96081631 đã viết:
Đương nhiên tôi thừa hiểu "ý đồ" của Nghĩa trong bài toán này... nhưng dù sao thì Nghĩa cũng phải đưa bài toán cho thực tế hơn một chút ---> Ai rảnh đâu mà nghĩ cái chuyện không thực tế kia chứ (đã quét dọn còn định vị cóc khô gì cho mệt)
Ẹc... Ẹc...

Em giả sử thầy muốn chọn một vùng nào đó làm List cho ComboBox, vậy nếu chọn hết từ ô A5 cho đến ô A65536 để add list hay sao? Phải End(xlUp) để loại trừ dòng rỗng chứ!

Bài tập này là em lấy ý tưởng từ bài này mà ra đây:

Hong.Van đã viết:
xuan.nguyen82 đã viết:

Tiếp tục bài 8 (Hic, em chỉ kẻ vẽ khung viền được như thế này thôi)

Mã:

Sub Xuan5() Worksheets("Sheet1").Activate With Range([B8], [B1000].End(xlUp)).Offset(, -1).Resize(, 4) .Borders.LineStyle = xlContinuous End With With Range("B1000").End(xlUp) .Offset(1, 1) = "Ngay thang nam" .Offset(2) = "Nguoi Lap Bang" .Offset(2, 2) = "Nguoi Kiem Soat" End With End Sub

Nhấp chuột vào đây để mở rộng...

Hi Hi , cái code này bấm 2 lần sao nhỉ
---------------
Spam 1 tý, mình cũng đang học hỏi đó!

SAODOINGOI_XD · 4/12/12

Chắc code thế này được chứ anh Nghĩa:

PHP:

Sub DataClear()
Set sw = Worksheets("Sheet1")
Sheets("Sheet1").Activate 
irow = sw.Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(5, 1), Cells(irow, 8)).ClearContents
End Sub

Good-Luck · 4/12/12

Với tất cả các bạn mới "vào nghề":

Nếu các bạn sau khi tự thực hành và đã gặp trường hợp như thế nào, bị lỗi ở đâu trền phần bài tập của mình, các bạn đưa cái lỗi ấy lên và chúng ta vừa gỡ rối để cùng nhau học tập nhé!

có câu này của sư huynh thì mọi người thảng nhiên up bài rồi hen, ko cần e ngại gì hết.

SAODOINGOI_XD đã viết:
Chắc code thế này được chứ anh Nghĩa:

PHP:

Sub DataClear() Set sw = Worksheets("Sheet1") Sheets("Sheet1").Activate irow = sw.Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(5, 1), Cells(irow, 8)).ClearContents End Sub

thì cũng dùng xlup rồi, mà ý anh Ndu thi ko xài tới xlup hay xldown

Bài này chắc chắn là 1 phần nhỏ trong 1 bài toán lớn nào đó
Đương nhiên các bạn có nhiều cách làm, nhưng nếu là tôi làm thì chả cần xlUp, xlDown gì ráo --> Cứ đơn giản làRange("A5:H60000").ClearContents cho khỏe thân
Đã "quét dọn" mà cũng tiết kiệm nữa sao?
Có thể ai đó sẽ nói rằng "vì sợ xóa nhầm "cái thứ gì đó" phía dưới dòng cuối cùng có dữ liệu của cột A" ---> Tôi sẽ trả lời rằng: "Dữ liệu kiểu đó là không thể chấp nhận !"

Hoàng Trọng Nghĩa · 4/12/12

SAODOINGOI_XD đã viết:
Chắc code thế này được chứ anh Nghĩa:

PHP:

Sub DataClear() Set sw = Worksheets("Sheet1") Sheets("Sheet1").Activate irow = sw.Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(5, 1), Cells(irow, 8)).ClearContents End Sub

Tốt lắm! Bạn đã chọn vùng chính xác! Mời các bạn tiếp tục giải tiếp nhé! Sau đó tôi sẽ nói nguyên do mà tôi đưa bài tập này lên đây!

Good-Luck đã viết:
thì cũng dùng xlup rồi, mà ý anh Ndu thi ko xài tới xlup hay xldown

Bài tập này là dùng End(xlUp) mai mốt còn dùng đến End(xlDown), End(xlToLeft), End(xlToRight) nữa các bạn ơi! Nếu chọn địa chỉ cứng ngắc, bất di bất dịch như vậy thì dữ liệu rỗng sẽ khủng khiếp lắm đấy!

SA_DQ đã viết:
Chú nên sửa lại tiêu đề giống như các đề bài khác đã có trong topic; đánh số tiếp tục;

(/iệc này sẽ tiện cho0 mọi người theo dõi, một khi được tác gia topic tóm lược vô bài đầu của topic.

(Bài này sẽ được xóa, 1 khi Nghĩa nhấn nút 'Thanks' & thực hiện những iêu cầu nhỏ nhẹ này!)

Coi như bài tập làm thêm được không ạ, Chính vẫn là bác SA, mọi bài tập căn bản đến nâng cao đều do Bác SA ra đề. Lâu lâu cũng có vài bài tập ngoại khóa để kiểm tra mức độ hiểu bài của các bạn mới tham gia chứ nhỉ?

ChanhTQ@ · 4/12/12

Một xu hướng khác nè:

Xài fương thức không đụng hàng: CurentRegion.Ofset(1). . . .

Hoàng Trọng Nghĩa · 4/12/12

Có vẻ các bạn cho là khó thì tôi cũng không muốn tham gia trong topic này nữa!

Hoàng Trọng Nghĩa đã viết:
Giả sử tôi có Sheet1 và một cơ sở dữ liệu, bắt đầu từ dòng 4 là dòng tiêu đề, tôi muốn các bạn xóa dữ liệu (ClearContents) từ dòng 5 trở đi, không xóa tiêu đề nha các bạn.

- Lấy cột A làm chuẩn.

- Dùng phương thức End(xlUp) để dò hàng cuối cùng của cột A rồi từ cột A các bạn tính hay xác định đến các cột khác để xóa dữ liệu.

- Sau khi hoàn tất thủ tục, gán macro xóa đó vào nút lệnh có sẳn (Xóa hàng).

- Bấm nút lệnh đó để chạy thủ tục.

- Bấm nút đó lần 2 để kiểm tra.

Ý nghĩa của bài tập này: Tìm ra lỗi code của mình và bẫy lỗi như thế nào.

Mục đích tôi:

1) Các bạn xác định được vùng cần tìm/ copy/ xóa/ tạo name/ gán mảng ... cho một vùng dữ liệu cần thiết

2) Nếu trường hợp dữ liệu không có, bạn phải biết cách để làm sao để xử lý nó.

Như bạn này:

SAODOINGOI_XD đã viết:
Chắc code thế này được chứ anh Nghĩa:

PHP:

Sub DataClear() Set sw = Worksheets("Sheet1") Sheets("Sheet1").Activate irow = sw.Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(5, 1), Cells(irow, 8)).ClearContents End Sub

Với thủ tục đó bạn đã làm rất đúng việc xác định vùng dữ liệu rồi, tôi hoan nghênh tinh thần của bạn.

Nhưng với lần thử code thứ 2 các bạn sẽ gặp một lỗi CỰC NGUY HIỂM đó là XÓA LUÔN CÁI TIÊU ĐỀ! Tôi dám chắc chắn 100% là như vậy nếu các bạn không biết bẫy lỗi!

Vậy thì thông qua cơ chế của End(xlUp) - cái này các bạn phải thử nhiều lần để thấy được việc này vì vậy tôi mới yêu cầu các bạn tự làm - thì không có dữ liệu nó sẽ lấy luôn phần cận trên của ô A5 tức là A4 và nếu không có gì cả nó sẽ chạy đến ô A1 mặc dù ta đặt mốc cho nó là A5.

Thế thì ta phải bẫy lỗi!

Thủ tục chỉ thế này thôi:

Mã:

Sub DataClear()
    Dim iRow As Long
    iRow = Sheet1.[A65536].End(xlUp).Row
    If iRow > 4 Then
        Sheet1.Range("A5:H" & iRow).ClearContents
    End If
End Sub

Với code trên các bạn tự tìm hiểu vì sao như vậy nhé!

Chào các bạn tại đây.

Ba Tê · 4/12/12

Hoàng Trọng Nghĩa đã viết:
Có vẻ các bạn cho là khó thì tôi cũng không muốn tham gia trong topic này nữa!
..............................................
Chào các bạn tại đây.

????????????????
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à.

xuan.nguyen82 · 4/12/12

Em hoàn thiện lại bài tập 8 sau khi mọi người góp ý.
Em cảm ơn ý kiến đóng góp quý báu của mọi người

Mã:

Public Sub Xuan5()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Dau As Long, Cuoi As Long, I As Long, TC As Double
Dim Tem As Long, SoThang As Long, Thang As Long, Mx As Double, Tong As String, Xuan As String
With Sheets("ChiFi")
    Set Rng = .Range(.[A4], .[A65000].End(xlUp))
End With
With Sheets("sheet1")
Xuan = .[B7].Value: Tong = .[H1].Value
    With .[A8:D1000]
        .ClearContents
        .Interior.ColorIndex = 0
        .Borders.LineStyle = xlNone
    End With
Dau = DateSerial(Year(.[C4]), Month(.[C4]), 1)
Cuoi = DateSerial(Year(.[C5]), Month(.[C5]), 1)
SoThang = DateDiff("m", Dau, Cuoi) + 1
For I = 1 To SoThang
    Mx = 0
    Thang = DateSerial(Year(Dau), Month(Dau) + I - 1, 1)
    .Cells(I + 7, 1).Value = I
    .Cells(I + 7, 2).Value = Xuan & " " & Format(Thang, "mm/yyyy")
    For Each Cll In Rng
        If Cll >= .[C4] And Cll <= .[C5] Then
                Tem = DateSerial(Year(Cll), Month(Cll), 1)
            If Tem = Thang Then
                .Cells(I + 7, 3).Value = .Cells(I + 7, 3).Value + Cll.Offset(, 4).Value
                TC = TC + Cll.Offset(, 4).Value
                If Mx < Cll.Offset(, 4).Value Then
                    Mx = Cll.Offset(, 4).Value
                    .Cells(I + 7, 4).Value = Cll.Value
                End If
            End If
        End If
    Next
Next I
    With .Range("B65000").End(xlUp)
        .Offset(1, -1).Resize(, 4).Interior.ColorIndex = 6
        .Borders.LineStyle = xlNone
        .Offset(1).Value = Tong
        .Offset(1, 1).Value = TC
        .Offset(3, 1) = [H2]
        .Offset(4) = [H3]
        .Offset(4, 2) = [H4]
    End With
    .Range(.[B8], .[B8].End(xlDown)).Offset(, -1).Resize(, 4).Borders.LineStyle = xlContinuous
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Good-Luck · 4/12/12

Hoàng Trọng Nghĩa đã viết:
Có vẻ các bạn cho là khó thì tôi cũng không muốn tham gia trong topic này nữa!

em vừa định phát ngôn thì anh BaTe đi trước rồi,

????????????????
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à.

do nhiều bạn ko xem tiêu đề tóp, đây chỉ là bài tập thực tập tất cả các hàm và lệnh của VBA cho người mới nhập, để làm quen, chứ chưa phải các bài làm thực tế sử dụng các bạn ạ.

Ba Tê · 4/12/12

xuan.nguyen82 đã viết:

Em hoàn thiện lại bài tập 8 sau khi mọi người góp ý.
Em cảm ơn ý kiến đóng góp quý báu của mọi người

Mã:

Public Sub Xuan5()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Dau As Long, Cuoi As Long, I As Long, TC As Double
Dim Tem As Long, SoThang As Long, Thang As Long, Mx As Double, Tong As String, Xuan As String
With Sheets("ChiFi")
    Set Rng = .Range(.[A4], .[A65000].End(xlUp))
End With
With Sheets("sheet1")
Xuan = .[B7].Value: Tong = .[H1].Value
    With .[A8:D1000]
        .ClearContents
        .Interior.ColorIndex = 0
        .Borders.LineStyle = xlNone
    End With
Dau = DateSerial(Year(.[C4]), Month(.[C4]), 1)
Cuoi = DateSerial(Year(.[C5]), Month(.[C5]), 1)
SoThang = DateDiff("m", Dau, Cuoi) + 1
For I = 1 To SoThang
    Mx = 0
    Thang = DateSerial(Year(Dau), Month(Dau) + I - 1, 1)
    .Cells(I + 7, 1).Value = I
    .Cells(I + 7, 2).Value = Xuan & " " & Format(Thang, "mm/yyyy")
    For Each Cll In Rng
        If Cll >= .[C4] And Cll <= .[C5] Then
                Tem = DateSerial(Year(Cll), Month(Cll), 1)
            If Tem = Thang Then
                .Cells(I + 7, 3).Value = .Cells(I + 7, 3).Value + Cll.Offset(, 4).Value
                TC = TC + Cll.Offset(, 4).Value
                If Mx < Cll.Offset(, 4).Value Then
                    Mx = Cll.Offset(, 4).Value
                    .Cells(I + 7, 4).Value = Cll.Value
                End If
            End If
        End If
    Next
Next I
    With .Range("B65000").End(xlUp)
        .Offset(1, -1).Resize(, 4).Interior.ColorIndex = 6
        [COLOR=#ff0000].Borders.LineStyle = xlNone[/COLOR]
        .Offset(1).Value = Tong
        .Offset(1, 1).Value = TC
        .Offset(3, 1) = [H2]
        .Offset(4) = [H3]
        .Offset(4, 2) = [H4]
    End With
    .Range(.[B8], .[B8].End(xlDown)).Offset(, -1).Resize(, 4).Borders.LineStyle = xlContinuous
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Cái dòng màu đỏ hình như bị "dờ ư dư huyền ... thừa" (Kiểu quýnh vần của concogia).

Mã:

With .Range("B65000").End(xlUp)
        .Offset(1, -1).Resize(, 4).Interior.ColorIndex = 6
        [COLOR=#ff0000][B].Borders.LineStyle = xlNone[/B][/COLOR]
        .Offset(1).Value = Tong
        .Offset(1, 1).Value = TC
        .Offset(3, 1) = [H2]
        .Offset(4) = [H3]
        .Offset(4, 2) = [H4]
    End With

Ẹc...

xuan.nguyen82 · 4/12/12

Hic. Rứa là bài 8 của em chưa phải là "hoàn thiện". Thôi, em cố gắng ở bài sau vậy ạ. Lên bảng giải bài tập kiểu này chắc em toàn mang "trứng vịt lộn" hay "trứng ngỗng" về nhà luộc ăn. 0 điểm tròn trĩnh cho bài tập. Hic hic....

Mờ mắt chân run thức đêm mần...với code
Viết code xong hoảng hốt thấy...bị thừa

.............

Ba Tê · 4/12/12

xuan.nguyen82 đã viết:
Hic. Rứa là bài 8 của em chưa phải là "hoàn thiện". Thôi, em cố gắng ở bài sau vậy ạ. Lên bảng giải bài tập kiểu này chắc em toàn mang "trứng vịt lộn" hay "trứng ngỗng" về nhà luộc ăn. 0 điểm tròn trĩnh cho bài tập. Hic hic....

Mờ mắt chân run thức đêm mần...với code
Viết code xong hoảng hốt thấy...bị thừa

.............

Dư nhưng không ảnh hưởng đến "hòa bình thế giới", nó vẫn chạy mà.
Chỉ là nhìn nó đứng đó mà chẳng ai ngó ngàng đến hơi "kỳ kỳ" vậy thôi.
(Bộ vừa viết code vừa đi sao mà chân run?
Nếu ngồi tại chỗ phải là "ông mê" chớ!)

xuan.nguyen82 · 4/12/12

Ba Tê đã viết:
Dư nhưng không ảnh hưởng đến "hòa bình thế giới", nó vẫn chạy mà.
Chỉ là nhìn nó đứng đó mà chẳng ai ngó ngàng đến hơi "kỳ kỳ" vậy thôi.
(Bộ vừa viết code vừa đi sao mà chân run?
Nếu ngồi tại chỗ phải là "ông mê" chớ!)

Hic, từ ngày em học VBA quả thật là đam mê. Có hôm quên cả ăn nên đói và thành "mắt mờ chân run" là đó ạ. hihi.

Thôi đợi bài tập 9 em sẽ cố gắng làm tốt hơn.

Kh Biet · 4/12/12

Học kiểu này mình thấy hay. Trò thức đêm, thày cũng thức đêm. Trò dậy sớm thày cũng dậy sớm. Đúng kiểu học mẫu giáo, chỉ khác thày không phải ru à ơi trong lúc ngủ gật thôi. Và hay nhất là không bị thầy gõ thước vào cái đầu gỗ .

ptm0412 · 4/12/12

Tôi thấy bài Trọng Nghĩa đưa ra là 1 bài tập rất thực tế. Xác định vùng xóa bên dưới tiêu đề bằng End(xlUp) mà không bẫy lỗi, thì khi không có dữ liệu sẽ xóa cả dòng tiêu đề, có khi xóa luôn dòng bên trên dòng tiêu đề luôn ấy chứ.

Nghĩa cũng thì dụ bằng code của saodoingoi, và thí dụ này chính là cái mà Nghĩa muốn nói:

Sub DataClear()
Set sw = Worksheets("Sheet1")
Sheets("Sheet1").Activate
irow = sw.Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(5, 1), Cells(irow, 8)).ClearContents
End Sub

Chạy lần 1, irow = 100, vùng xóa là A5:H100
Chạy lần 2, irow = 4, vùng xóa là A5:H4 hoặc viết xuôi lại là A4:H5, xóa tiêu đề dòng 4.

Giả sử tiêu đề A4 không có, (Có thể là STT nhưng bỏ trống), thế thì irow = 1 hoặc 2, 3, vùng xóa sẽ là A5:H1 hoặc A5:H2 hoặc A5:H3, ...

Chạy lần 3, A4 đã bị xóa trong lần 2, sẽ xóa tiếp lên trên dòng 4.

ptm0412 · 4/12/12

Thí dụ bài fill công thức cho nhiều vùng bên dưới tiêu đề, mỗi vùng cách nhau 1 dòng có tiêu đề con,
http://www.giaiphapexcel.com/forum/...iúp-đỡ-về-macro-fill-down&p=456351#post456351

PHP:

Sub FillFormula()
Dim EndR As Long, BeginR As Long
    EndR = Sheet5.[A65000].End(xlUp).Row
    BeginR = Sheet5.Cells(EndR, 1).End(xlUp).Row
Do
    Sheet5.Cells(BeginR, 3).Resize(1, 11).AutoFill _
    Destination:=Sheet5.Cells(BeginR, 3).Resize(EndR - BeginR + 1, 11)
    EndR = Sheet5.Cells(BeginR, 1).End(xlUp).Row
    BeginR = Sheet5.Cells(EndR, 1).End(xlUp).Row
    If BeginR < 6 Then Exit Do
Loop
End Sub

Nếu không có điều kiện If BeginR < 6 sẽ xảy ra 2 lỗi:

- Những dòng từ 5 đến 1 cũng bị fill từng vùng nhỏ một, (hoặc gom thành 1 vùng), mất dòng tiêu đề, thay vào đó là nội dung dòng trên của nó
- Khi đến dòng 1, code không thoát vòng lặp, chạy mòn mỏi.

Không những thế, viết code xong còn phải khuyến cáo cột A đánh số thứ tự phải đúng, không trống ô nào. Chèn dòng xong không đánh số TT là thường tình.

thanhlanh · 5/12/12

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).

Quang_Hải · 5/12/12

thanhlanh đã viết:
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 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

concogia · 5/12/12

quanghai1969 đã viết:
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

Ôi Trời ơi, hay quá. Bái phục, bái phục
Nhưng:

thanhlanh
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.

Híc, híc, híc

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

/(hông là gì!

Huyền thoại GPE

Chuyên gia GPE

Thành viên chính thức

Thành viên tiêu biểu

Chuyên gia GPE

0901452không62

Chuyên gia GPE

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

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

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

Thành viên tích cực

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

Thành viên tích cực

Cánh hạc đầu đông

Bad Excel Member

Bad Excel Member

Thành viên tích cực

Thành viên gạo cội

Gội rồi mới Cạo

Facebook

Group