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

[SA_DQ]

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

​

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

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Em xin trả lời Bài 1

Sub Bai1()
[B2] = [a1] & " " & Format([a2], "Currency")
[B2].Characters(Len([a1]) + 2, Len([a1]) - Len([a2]) + 3).Font.Underline = 2
End Sub

Bài có đúng hem chị? Tiếp bài mới đi chị.

 

[ndu96081631]

Bài có đúng hem chị? Tiếp bài mới đi chị.

Thật ra bài này cũng không phải là dễ đâu nha
Tác giả nói rằng:

Mặt khác định dạng ô giống với ô mang số liệu

Giống ở đây có nghĩa là:
- A2 format chữ đậm thì kết quả cũng chữ đậm
- A2 format màu đỏ thì kết quả cũng màu đỏ
- A2 dùng font gì thì kết quả dùng font đó
- A2 đang đặt cỡ chữ bao nhiêu thì kết quả cũng cỡ chữ bấy nhiêu
vân vân...
Bài của bạn chỉ mới GẠCH CHÂN... mà là bạn cố tình gạch chân thôi cứ không phải "theo" format của A2
Không biết bạn có hiểu không nhỉ?


-------------
Sư phụ HYen17 cũng nên cho file giả lập (cả kết quả giả lập) lên cho dễ thí nghiệm sư phụ à!

 

[dhn46]

Đề 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!

Chú cho cháu xác nhận chút về đề bài:
1 -"ô trên ô có số" vậy nếu ô đầu tiên trong mảng là số thì sẽ lây ô trên là ô nào?
2 - "định dạng ô giống với ô mang số liệu"là định dạng của cả 1 Cell phải không ạ?
Cảm ơn chú!

 

[SA_DQ]

Cho cháu xác nhận chút về đề bài:
1 -"ô trên ô có số" vậy nếu ô đầu tiên trong mảng là số thì sẽ lây ô trên là ô nào?
2 - "định dạng ô giống với ô mang số liệu"là định dạng của cả 1 Cell phải không ạ?

Rất Cảm ơn bạn!
1./ Không có trường hợp vậy đâu; Trên ô số liệu là ô chứa chuỗi dữ liệu;
Bạn có thể dùng fương thức SpecialCells vô tư nha;

2./ Dịnh dạng cả ô đó bạn;

 

[dhn46]

Rất Cảm ơn bạn!
1./ Không có trường hợp vậy đâu; Trên ô số liệu là ô chứa chuỗi dữ liệu;
Bạn có thể dùng fương thức SpecialCells vô tư nha;

2./ Dịnh dạng cả ô đó bạn;

Dạ cái này cháu hỏi cho chắc: Ví dụ mảng chạy từ A1:A10, A1 = 1 => ô trên ô 1 không có mà ô 1 là số vậy xử lý như thế nào ạ?

 

[Quang_Hải]

Rất cảm ơn bạn đã quan tâm!
Đề 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!

Lâu lâu sư phụ ra 1 bài cho người mới bắt đầu mà em đuối luôn. Cứ mần thí coi sao. Đề bài đã khó rồi, anh NDU thêm cho mấy câu chú thích nữa nên muốn bỏ chạy luôn. Thôi cũng record macro và edit lại cho nó dễ nhìn tí.
Em dám chắc là trong thực tế sẽ không bao giờ em gặp bài này, hic.

Sub test()
Dim dulieu As Range, i As Long
Set dulieu = Range([A1], [A65536].End(3))
For i = 1 To dulieu.Rows.Count
   If IsNumeric(dulieu(i, 1)) Then
      With dulieu(i, 1).Offset(, 1)
         .Value = dulieu(i - 1, 1) & " " & dulieu(i, 1).Text
         With .Characters(Len(dulieu(i - 1, 1)) + 1, Len(dulieu(i, 1).Text)).Font
            .FontStyle = dulieu(i, 1).Font.FontStyle
            .Size = dulieu(i, 1).Font.Size
            .Name = dulieu(i, 1).Font.Name
            .Color = dulieu(i, 1).Font.Color
            .Underline = dulieu(i, 1).Font.Underline
         End With
      End With
    End If
Next
End Sub

 

[dhn46]

Anh QuangHai nếu [A1] = 1 thì sao nhỉ?

 

[ndu96081631]

Anh QuangHai nếu [A1] = 1 thì sao nhỉ?

Người ta đã nói:
- Dữ liệu xen kẽ nhau
- Cell đầu của dữ liệu là Text, cell tiếp theo là number
- Cứ thế đến hết
Bạn lại cứ thắc mắc hoài
Ôi... mà dù dữ liệu là cái quái gì thì cũng.. thây kệ nó đi. Việc của bạn chỉ cần nối từng cặp lại với nhau, bảo đảm giữ nguyên format là được rồi
--------------------
QuangHai cũng.. TINH ghê he! Dùng .Text chứ mà .Value thì đến tết chà và cũng không ra
Ẹc... Ẹc...

 

[Quang_Hải]

Anh QuangHai nếu [A1] = 1 thì sao nhỉ?

Ai biết đâu. Đề thi cho sẵn vậy rồi nên mần theo đề thi thôi. Nhiêu đó là muốn té rồi.
Nếu A1 = 1 thì phát sinh lỗi chứ sao nữa. Thêm em On Error Resume Next vào thôi

Người ta đã nói:
- Dữ liệu xen kẽ nhau
- Cell đầu của dữ liệu là Text, cell tiếp theo là number
- Cứ thế đến hết
Bạn lại cứ thắc mắc hoài
Ôi... mà dù dữ liệu là cái quái gì thì cũng.. thây kệ nó đi. Việc của bạn chỉ cần nối từng cặp lại với nhau, bảo đảm giữ nguyên format là được rồi
--------------------
QuangHai cũng.. TINH ghê he! Dùng .Text chứ mà .Value thì đến tết chà và cũng không ra
Ẹc... Ẹc...

Tinh gì anh ơi, cũng mò cả buổi mới ra. Lúc đâu không chấm gì cả, rồi đến .Value, quậy mãi mới ra cái .Text

 

[SA_DQ]

Đúng bài đầu là quá khó, xin rút kinh nghiệm; Sau đây là bài 2

Bài 2

Thống kê số lần lặp lại của các loại fương tiện như bảng dưới đây:

​

A | B | C |. . .| AA | AB |
Car|Mercedes|2 000||Car|?|<= 2
Car|BMW|2 400|. . .|Bike|?|<= 2
Bike|BT|600|. . .|Plane|?|<= 1
Blane|Boing|6 000 000|. . .|||
Bike|CKPig|900|. . .|||

 

[ndu96081631]

Đúng bài đầu là quá khó, xin rút kinh nghiệm

Lỡ rồi, em xơi luôn bài 1 hen

Private Sub MergeStr(ByVal Source_Range As Range, ByVal Sep As String, ByVal Target As Range)
  Dim rCel As Range, fnt As Font
  Dim st As Long, lText As Long
  Target.Value = JoinRngText(Source_Range, Sep)
  st = 1
  For Each rCel In Source_Range
    lText = Len(rCel.Text)
    Set fnt = rCel.Font
    With Target.Characters(st, Len(rCel.Text)).Font
      .FontStyle = fnt.FontStyle
      .Name = fnt.Name
      .ColorIndex = fnt.ColorIndex
      .Size = fnt.Size
      .Underline = fnt.Underline
      .Strikethrough = fnt.Strikethrough
      .Superscript = fnt.Superscript
      .Subscript = fnt.Subscript
    End With
    st = st + Len(rCel.Text) + Len(Sep)
  Next
End Sub

Function JoinRngText(ByVal Source_Range As Range, ByVal Sep As String) As String
  Dim Arr(), n As Long, rCel As Range
  On Error Resume Next
  For Each rCel In Source_Range
    n = n + 1
    ReDim Preserve Arr(1 To n)
    Arr(n) = rCel.Text
  Next
  If n Then JoinRngText = Join(Arr, Sep)
End Function

Sub Main()
  Dim lR As Long, rng As Range
  Application.ScreenUpdating = False
  Set rng = Selection
  For lR = 1 To rng.Rows.Count - 1 Step 2
    MergeStr rng(lR, 1).Resize(2), " ", rng(lR + 1, 2).Resize(1, 1)
  Next
  Application.ScreenUpdating = True
End Sub

Quét chọn cột nào mà ta muốn merge rồi chạy Sub Main

em hỏi luôn: em thấy nếu không khai báo biến mà dùng luôn ví dụ: for i = 1 to 100 chương trình vẫn chạy bình thường =>? tác dụng của khai báo biến?

em thấy lúc thì pri sub lúc thì sub vậy khi nào khi pri sub và khi nào thì sub?

Bạn không nên hỏi mấy thứ này ở đây, vì:
- Thứ nhất: không đúng chủ đề
- Thứ hai: những thứ bạn hỏi đều đã có giải đáp trên GPE rồi ---> Search sẽ thấy

 

[Kh Biet]

Chào các thầy, chào các bạn.
Nhà em xin chầu rìa để xem thôi, không dám có ý kiến. "anh chàng ngốc" xông ra vẫn là người giỏi đấy ạ.
Sau khi có lời giải của bạn Quanghai, nhà em tải về chạy thử để học, thì thấy số cuối cùng không chạy theo yêu cầu. Không biết lỗi chỗ nào ạ ? tập tin đính kèm .

 

[ndu96081631]

Chào các thầy, chào các bạn.
Nhà em xin chầu rìa để xem thôi, không dám có ý kiến. "anh chàng ngốc" xông ra vẫn là người giỏi đấy ạ.
Sau khi có lời giải của bạn Quanghai, nhà em tải về chạy thử để học, thì thấy số cuối cùng không chạy theo yêu cầu. Không biết lỗi chỗ nào ạ ? tập tin đính kèm .

Trong code có đoạn:

With .Characters(Len(dulieu(i - 1, 1)) [COLOR=#ff0000]+ 1[/COLOR], Len(dulieu(i, 1).Text)).Font

Sửa thành vầy cho chắc:

With .Characters(Len(dulieu(i - 1, 1)) [COLOR=#ff0000]+ 2[/COLOR], Len(dulieu(i, 1).Text)).Font

cám ơn thày, nhà em hiểu rồi. Nếu +1 số cuối không chạy theo yêu cầu, +3 trở đi các số đầu không chạy theo yêu cầu số =0 format chuyển sang chuỗi text.
Cám ơn thày và cả nhà, cám ơn bạn Quanghai.

Mình nói ngoài lề 1 chút:
Nói thật lòng là mình chẳng tài nào tin được bạn lại không biết gì về code (không biết công thức Excel còn có thể tin)... Lý do là vì qua cách nói chuyện của bạn, không hiểu sao mình cứ mường tượng bạn phải là đại cao thủ trong lĩnh vực lập trình mới đúng
Ẹc... Ẹc...

 

[Quang_Hải]

Sư phụ và anh NDU thêm cái +2 vào thì hết vui rồi. Lẽ ra các thành viên phải tự tìm hiểu và khám phá ra cú pháp start và length của .Characters

 

[Kh Biet]

Trong code có đoạn:

With .Characters(Len(dulieu(i - 1, 1)) [COLOR=#ff0000]+ 1[/COLOR], Len(dulieu(i, 1).Text)).Font

Sửa thành vầy cho chắc:

With .Characters(Len(dulieu(i - 1, 1)) [COLOR=#ff0000]+ 2[/COLOR], Len(dulieu(i, 1).Text)).Font

cám ơn thày, nhà em hiểu rồi. Nếu +1 số cuối không chạy theo yêu cầu, +3 trở đi các số đầu không chạy theo yêu cầu số =0 format chuyển sang chuỗi text.
Cám ơn thày và cả nhà, cám ơn bạn Quanghai.

 

[dhn46]

Đã 12 giờ không thấy ai nộp bài, em xin nộp vậy, mong các thầy cô chỉ dẫn thêm

Sub bai2()
Dim Arr, sArr
Dim i, k As Integer
Dim dic As Object
Arr = Range("A2:B" & Range("A65536").End(xlUp).Row)
ReDim sArr(1 To UBound(Arr, 1), 1 To 3)
With CreateObject("Scripting.dictionary")
    For i = 1 To UBound(Arr)
        If Not .Exists(Arr(i, 1)) Then
            k = k + 1
            .Add Arr(i, 1), k
            sArr(k, 1) = Arr(i, 1)
            sArr(k, 2) = Arr(i, 2)
            sArr(k, 3) = 1
        Else
            sArr(.Item(Arr(i, 1)), 2) = sArr(.Item(Arr(i, 1)), 2) & ", " & Arr(i, 2)
            sArr(.Item(Arr(i, 1)), 3) = sArr(.Item(Arr(i, 1)), 3) + 1
        End If
    Next
End With
[H2].Resize(UBound(sArr, 1), 3) = sArr
End Sub

 

[Quang_Hải]

Mình nói ngoài lề 1 chút:
Nói thật lòng là mình chẳng tài nào tin được bạn lại không biết gì về code (không biết công thức Excel còn có thể tin)... Lý do là vì qua cách nói chuyện của bạn, không hiểu sao mình cứ mường tượng bạn phải là đại cao thủ trong lĩnh vực lập trình mới đúng
Ẹc... Ẹc...

Em cũng mạn phép nhận xét tí, em cũng nghĩ là vậy, và thành viên này khá quen thuộc. Đọc cách viết của thành viên này quen quen. Chắc là bình cũ rượu mới hay bình mới rượu cũ gì đây thôi.
Bài này cho người mới bắt đầu thì dùng Dic và Array thì nặng tay quá. Nếu các thành viên mới có nhìn thấy cũng khóc ròng

Sub test2()
Dim i As Long
[F1] = [A1]: [G1] = "So Lan"
Range([A1], [A65536].End(3)).AdvancedFilter 2, , [F1], 2
For i = 2 To [F65536].End(3).Row
   Cells(i, 7) = Application.CountIf([A:A], Cells(i, 6))
Next
End Sub

 

[SA_DQ]

Bài thứ ba: Trích lọc danh sách lao động tiên tiến của 1 năm

Ở CQ (cơ quan) nọ người ta đã thống kê danh sách đạt danh hiệu LĐTT như bảng sau:

TT|HoTen|Nữ|NgaySnh|Quê/Tỉnh|ĐVị|2008|2009|2010|2011|2012
1|Hòa Nga Nhi|X|6/02/1980|Bình Fước|KT|X|X||X
2|Hà Hồ Ngọc||6/09/1981|Bình Tuy|Fx1|X||X|X|
3|Võ Nghi Vỹ||6/21/1980|Bình Định|KCS|X||X|X|x
4|Nguyễn Việt Hồng||07/01/1947|Huế|TCHC|X|X||X|x
5|Lê Thị Thơm||6/21/1980|Kiến An|KH||X|X|X|X
6|Bùi Xuân Thắm||6/21/1970|Vĩnh Long|TVu|X||X|X|x
|. . .|X|. . |.. .. ..||..||..||

Các bạn hãy tạo ra macro giúp đơn vị nọ lọc ra danh sách LĐTT của 1 năm nào đó bất kỳ;
Như trong hình dưới đây là lọc từ file đính kèm DS LĐTT năm 2008
(Chọn sự kiện năm tại ô [AE1])

 

[Kh Biet]

Chào bạn Quanghai, chào bạn Dhn46
Cám ơn các bạn đã làm bài tập. có vài bài giải thế này, người mới học dễ so sánh các phương án hơn, do vậy dễ nhớ và nhớ lâu hơn. Bài giải của bạn Quanghai dễ hiểu, đơn giản hơn, bài của bạn Dhn46 thì dân lớp dưới bọn mình phải để "gặm" dần chắc mới hiểu được. Mình text thử thấy code của quanghai 2 cột tên ĐTượng nên mình chuyển qua trái 1 cột cho gọn hơn 1 chút :

Sub test2()
Dim i As Long
[E1] = [A1]: [F1] = "So Lan"
Range([A1], [A65536].End(3)).AdvancedFilter 2, , [E1], 2
For i = 2 To [E65536].End(3).Row
Cells(i, 6) = Application.CountIf([A:A], Cells(i, 5))
Next
End Sub

Mình mới nhập GPE là thật, mình muốn học là thật, Mình không biết là thật, và mình kính phục các thày và các bạn là thật. Mong các bạn đừng nghĩ sai về mình .
cám ơn các thày và các bạn.