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

[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 làm theo cách hiểu của em như sau (trình độ mầm non VBA).
Bài tập 5

Public Sub Xuan3()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Dau As Long, Cuoi As Long, I As Long, Tem As Long, SoThang As Long, Thang As Long
With Sheets("ChiFi")
    Set Rng = .Range(.[A4], .[A65000].End(xlUp))
End With
With Sheets("sheet1")
.[A8:C1000].ClearContents
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
    Thang = DateSerial(Year(Dau), Month(Dau) + I - 1, 1)
    .Cells(I + 7, 1).Value = I
    .Cells(I + 7, 2).Value = "Thang " & Format(Thang, "mm/yyyy")
    For Each Cll In Rng
            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
        ElseIf Tem > Thang Then
            Exit For
        End If
    Next
Next I
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

Cái này nên cho điều kiện lọc theo ngày mới chính xác. Để như thế thì gõ ngày xem như ngày vô nghĩa. Nó sẽ lọc ra từ ngày đầu tháng.
p/s: Em copy code trên diễn đàn và edit lại thôi chứ có biết chi đâu ạ, em mới học thôi ạ, đừng hiểu lầm tội nghiệp.

 

[xuan.nguyen82]

Cái này nên cho điều kiện lọc theo ngày mới chính xác. Để như thế thì gõ ngày xem như ngày vô nghĩa. Nó sẽ lọc ra từ ngày đầu tháng.

Tại vì em mới hiểu được như vậy, cảm ơn anh đã góp ý. em sẽ sửa lại sau. Mới đầu, em chỉ biết bước đi từng bước là từ cái này đến cái kia. Em sẽ sửa lại bài này.

p/s: Em copy code trên diễn đàn và edit lại thôi chứ có biết chi đâu ạ, em mới học thôi ạ, đừng hiểu lầm tội nghiệp.

hic, Chàng Ngốc ơi, biết "sửa" lại code của GPE là cả 1 vấn đề lớn đấy ạ. Em cũng muốn học để mà "sửa" được code nhưng học mãi vẫn chưa qua trình mầm non và mẫu giáo. Nhưng có vấn đề gì đâu nhỉ? Lớp đàn em chúng em rất cần những bài như các anh và các thầy post lên để đọc, nghiền ngẫm và nghiên cứu....
em cảm ơn anh và các thầy cùng các anh chị.

Cái này nên cho điều kiện lọc theo ngày mới chính xác. Để như thế thì gõ ngày xem như ngày vô nghĩa. Nó sẽ lọc ra từ ngày đầu tháng.
.

Sửa lại bài 5.

Public Sub Xuan3()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Dau As Long, Cuoi As Long, I As Long, Tem As Long, SoThang As Long, Thang As Long
With Sheets("ChiFi")
    Set Rng = .Range(.[A4], .[A65000].End(xlUp))
End With
With Sheets("sheet1")
.[A8:C1000].ClearContents
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
    Thang = DateSerial(Year(Dau), Month(Dau) + I - 1, 1)
    .Cells(I + 7, 1).Value = I
    .Cells(I + 7, 2).Value = "Thang " & 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
            End If
        End If
    Next
Next I
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

 

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

Vẫn chưa được bạn ơi, hình như chưa ra kết quả theo ý muốn.

Theo ý anh sẽ sửa như thế nào là đúng nhất ạ? Anh cho em ý kiến hoặc sửa giùm em để em biết ạ?

Hỏng biết sửa và cũng chưa test thử, hình như thay số 1 thành ngày của ngày bắt đầu và ngày kết thúc.... HÌnh như vậy.

 

[ChanhTQ@]

Sửa lại bài 5.

Public Sub Xuan3()
 ' . . . . . . '
 SoThang = DateDiff("m", Dau, Cuoi) + 1
 For I = 1 To SoThang
    Thang = DateSerial(Year(Dau), Month(Dau) + I - 1, 1)
    .Cells(I + 7, 1).Value = I
    .Cells(I + 7, 2).Value = "Thang " & 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
            End If
        End If
    Next
  ' **  * *    **    * *'
    Next I
 End With
'  ..   ... ... ...'
End Sub

Hình như Code XN làm vầy: Cứ mỗi 1 tháng thì CT (chương trình) qua trang 'ChiFí' chạy 1 vòng từ đầu đến cuôi CSDL để tìm ra fát sinh trong tháng để ghi lại;

Có thể có cách khác hơn để đẩy tiến độ hơn chăng, như AdvancedFilter cái tháng đó ra 1 chổ nào đó & xài SUMIF()

Thử lúc rỗi xem sao;

(Nếu chịu thử, thì còn cách nữa là không cần AdvancedFilter, mà tính bằng DSUM() luôn theo Criterie là Ngày đầu. . Ngày cuối )
Chúc thành công.

 

[Hai Lúa Miền Tây]

Vẫn chưa được bạn ơi, hình như chưa ra kết quả theo ý muốn.

Code ok mà bạn, tuy nhiên nên hạn chế vòng lặp.

 

[Như Đã Dấu Yêu]

Hic, em đọc mà lung bung hết cái đầu rồi. thử viết lại code của mọi người mà nó không chịu chạy.

 

[SA_DQ]

Hic, em đọc mà lung bung hết cái đầu rồi. thử viết lại code của mọi người mà nó không chịu chạy.

Trước khi viết lại, ta cần fải biết từng dòng lệnh trong Code đó làm cái gì; Có nghĩa là bạn fải dịch từ ngôn ngữ VBA sang ngôn ngữ Việt.

Bí chổ nào dùng MsgBox để nó cho ta thông tin mà ta cần biết.

Bí nữa thì đưa đến BOX "Giải thích, gở rối. . . VBA" để mọi người dịch dòng lệnh đó cho!

=> xuan.nguyen82;455588 Theo ý anh sẽ sửa như thế nào là đúng nhất ạ? Anh cho em ý kiến hoặc sửa giùm em để em biết ạ?

Chổ cần chú ý là ngày bắt đầu khảo sát chưa hẵn là ngày đầu của tháng (& ngày kết thúc cũng vậy; chưa hẵn là ngày cuối của 1 tháng nào đó)
Bạn cần xử thêm cái vụ này!

 

[Ba Tê]

.................
Chổ cần chú ý là ngày bắt đầu khảo sát chưa hẵn là ngày đầu của tháng (& ngày kết thúc cũng vậy; chưa hẵn là ngày cuối của 1 tháng nào đó)
Bạn cần xử thêm cái vụ này!

Cái này trong code của xuan.nguyen82 đã có rồi mà:

If Cll >= .[C4] And Cll <= .[C5] Then

 

[SA_DQ]

Cái này trong code của xuan.nguyen82 đã có rồi mà:

Ờ hén; Xin lỗi các bạn & XN82, mình nhằm do chưa coi kỹ.

 

[Quang_Hải]

Đã nói là các bài tập cơ bản cho những người mới bắt đầu làm quen VBA vậy mà cứ phang toàn là đồ chơi thứ thiệt không hà. Tàn nhẫn với tui quá. Đề nghị xử lý trên sheet hết nha... cho mấy em mới học như em còn theo kịp.

 

[xuan.nguyen82]

Đã nói là các bài tập cơ bản cho những người mới bắt đầu làm quen VBA vậy mà cứ phang toàn là đồ chơi thứ thiệt không hà. Tàn nhẫn với tui quá. Đề nghị xử lý trên sheet hết nha... cho mấy em mới học như em còn theo kịp.

Cao thủ VBA như anh mà nói vậy thì chắc em chạy...mất dép như chơi. Em cũng mới học hành, tập tành vật lộn với nó mà đầu óc cứ ong ong. Tối mơ ngủ còn thấy Sub với End sub.
Hic hic

 

[ndu96081631]

Đã nói là các bài tập cơ bản cho những người mới bắt đầu làm quen VBA vậy mà cứ phang toàn là đồ chơi thứ thiệt không hà. Tàn nhẫn với tui quá. Đề nghị xử lý trên sheet hết nha... cho mấy em mới học như em còn theo kịp.

Nếu gọi là VBA dành cho người mới học thì phải vầy:
- Code xử dụng For.. Next là tối đa
- Không dùng các control, object cao cấp (như Dictionary, VBScript, ADO... vân vân...)
- Ưu tiên dùng các công cụ có sẵn như Advanced Filter, AutoFilter... vân vân... mà code có được từ việc record macro tạo ra
- Có thể dùng WorksheetFunction để tận dụng các hàm trên bảng tính mà ta đã biết
------------------
Cá nhân tôi nghĩ như vậy, không biết các bạn khác thì sao?

 

[SA_DQ]

Bài tập 6: Thêm vô cột ghi chú (bài #29) ngày có chi fí cao nhất trong từng tháng

​

Nhân 2 ngày cuối tuần, xin đề nghị các bạn nào rỗi ta tiếp tục cái nha.

Rất mong các bạn tiếp tục hưởng ứng & xin cảm ơn nhiều!

 

[Kh Biet]

Theo hướng gợi ý của thày Chanh TQ@ nhà em đã làm bài theo hướng này, kết hợp với code của bạn QuangHai, mong các bạn góp ý cho hoàn chỉnh hơn .

 

[Quang_Hải]

Theo hướng gợi ý của thày Chanh TQ@ nhà em đã làm bài theo hướng này, kết hợp với code của bạn QuangHai, mong các bạn góp ý cho hoàn chỉnh hơn .

Bài này em sẽ kết hợp 1 mảng và vẫn xử lý trên sheet, không dùng công thức vì nhìn công thức là em muốn nghỉ học rồi.

Sub Qhai()
Dim I As Long, cell As Range, dulieu()
   With Sheets("ChiFi")
      dulieu = .Range(.[A4], .[A65536].End(3)).Resize(, 5).Value
   End With
   With ActiveSheet
      .[B8:E1400].ClearContents
      For I = 1 To DateDiff("m", .[D4], .[D5]) + 1
         .Cells(I + 7, 2).Value = I
         .Cells(I + 7, 3) = "Tháng " & Format(DateAdd("m", I - 1, .[D4]), "mm/yy")
      Next I
   End With
   Range("D8:D1400").Clear
   For Each cell In Range("C8:C" & [C65536].End(3).Row)
      For I = 1 To UBound(dulieu)
         If Right(cell, 5) = Format(dulieu(I, 1), "mm-yy") Then
            cell.Offset(, 1) = cell.Offset(, 1) + dulieu(I, 5)
         End If
      Next
   Next
End Sub

 

[Ba Tê]

Theo hướng gợi ý của thày Chanh TQ@ nhà em đã làm bài theo hướng này, kết hợp với code của bạn QuangHai, mong các bạn góp ý cho hoàn chỉnh hơn .

Bạn thử nhập từ ngày 31/01/2010 đến ngày 31/12/2010 xem Tháng 01/2010 kết quả bao nhiêu phí?

Bài này em sẽ kết hợp 1 mảng và vẫn xử lý trên sheet, không dùng công thức vì nhìn công thức là em muốn nghỉ học rồi.

Sub Qhai()
Dim I As Long, cell As Range, dulieu()
   With Sheets("ChiFi")
      dulieu = .Range(.[A4], .[A65536].End(3)).Resize(, 5).Value
   End With
   With ActiveSheet
      .[B8:E1400].ClearContents
      For I = 1 To DateDiff("m", .[D4], .[D5]) + 1
         .Cells(I + 7, 2).Value = I
         .Cells(I + 7, 3) = "Tháng " & Format(DateAdd("m", I - 1, .[D4]), "mm/yy")
      Next I
   End With
   Range("D8:D1400").Clear
   For Each cell In Range("C8:C" & [C65536].End(3).Row)
      For I = 1 To UBound(dulieu)
         If Right(cell, 5) = Format(dulieu(I, 1), "mm-yy") Then
            cell.Offset(, 1) = cell.Offset(, 1) + dulieu(I, 5)
         End If
      Next
   Next
End Sub

Hổng dùng mảng, Filter, Hàm Excel...
Chỉ FOR ... NEXT, rồi IF ... END IF ...Tối hù con mắt luôn.

Public Sub GPE()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Dong As Long, DK1 As Long, DK2 As Long, Tem As Double
With Sheets("Sheet1")
    DK1 = .[C4].Value
    DK2 = .[C5].Value
    .[A8:D1000].ClearContents
End With
Dong = 7
With Sheets("ChiFi")
    Set Rng = .Range(.[A4], .[A65000].End(xlUp)).Resize(, 5)
End With
With Sheets("sheet1")
For Each Cll In Rng
    If Cll.Value >= DK1 And Cll.Value <= DK2 Then
        If Month(Cll) <> Month(Cll.Offset(-1)) Then
            Dong = Dong + 1
            Tem = 0
        ElseIf Dong = 7 Then
            Dong = 8
        End If
            .Cells(Dong, 1) = Dong - 7
            .Cells(Dong, 2) = "Thang " & Format(Cll, "mm/yyyy")
            .Cells(Dong, 3) = .Cells(Dong, 3) + Cll.Offset(, 4)
            If Tem < Cll.Offset(, 4) Then
                Tem = Cll.Offset(, 4)
                .Cells(Dong, 4) = Cll
            End If
    End If
Next
End With
Set Rng = Nothing
Application.ScreenUpdating = False
End Sub

Híc! Dư 1 biến Mx trong file.

 

[Quang_Hải]

Hổng dùng mảng, Filter, Hàm Excel...
Chỉ FOR ... NEXT, rồi IF ... END IF ...Tối hù con mắt luôn.

Lúc trước thấy mảng và dic thì sợ bén chết, chỉ khoái dùng trực tiếp trên sheet, giờ sao lại thấy xử lý trên sheet khó ăn thiệt. Mần đươc cũng trầy trụa khắp người

 

[Quang_Hải]

Cám ơn thày.
Nhà em đã sửa lại, thực ra đây là một hướng, thày và các bạn kiểm tra, nhà em chỉ thử theo hướng này thôi, coi nó là một phương án .

Bài này hình như kết quả hơi trật tí xíu. Tổng chi phí của tháng 1-2010 công thủ công khác chút chút là 2.681.000, code cộng là 863.000. Cũng không nhiều lắm hén.
Nếu dùng cột phụ để tạo hàm SumIf thì mình làm thế này:

Sub QHai()
Dim I As Long, CF As Worksheet
Set CF = Sheets("ChiFi")
   With ActiveSheet
      .[B8:E1400].ClearContents
      For I = 1 To DateDiff("m", .[D4], .[D5]) + 1
         .Cells(I + 7, 2).Value = I
         .Cells(I + 7, 3) = "Tháng " & Format(DateAdd("m", I - 1, .[D4]), "mm/yy")
      Next I
   End With
   CF.Range(CF.[A4], CF.[A65536].End(3)).Offset(, 9).Formula = "=Text(A4,""mm-yy"")"
   Range("D8:D1400").Clear
   With Range("D8:D" & [C65536].End(3).Row)
      .Formula = "=SUMIF(ChiFi!C10:C10,Right(RC[-1],5),ChiFi!C5:C5)"
      .Value = .Value
   End With
   CF.[J4:J10000].ClearContents
End Sub

 

[Ba Tê]

Bài này hình như kết quả hơi trật tí xíu. Tổng chi phí của tháng 1-2010 công thủ công khác chút chút là 2.681.000, code cộng là 863.000. Cũng không nhiều lắm hén.
Nếu dùng cột phụ để tạo hàm SumIf thì mình làm thế này:

Sub QHai()
Dim I As Long, CF As Worksheet
Set CF = Sheets("ChiFi")
   With ActiveSheet
      .[B8:E1400].ClearContents
      For I = 1 To DateDiff("m", .[D4], .[D5]) + 1
         .Cells(I + 7, 2).Value = I
         .Cells(I + 7, 3) = "Tháng " & Format(DateAdd("m", I - 1, .[D4]), "mm/yy")
      Next I
   End With
   CF.Range(CF.[A4], CF.[A65536].End(3)).Offset(, 9).Formula = "=Text(A4,""mm-yy"")"
   Range("D8:D1400").Clear
   With Range("D8:D" & [C65536].End(3).Row)
      .Formula = "=SUMIF(ChiFi!C10:C10,Right(RC[-1],5),ChiFi!C5:C5)"
      .Value = .Value
   End With
   CF.[J4:J10000].ClearContents
End Sub

Coi chừng việt vị à nghe. 2681000 là tổng cả tháng 01/2010. điều kiện trong file bắt đầu từ 31/01/2010....

 

[Quang_Hải]

Coi chừng việt vị à nghe. 2681000 là tổng cả tháng 01/2010. điều kiện trong file bắt đầu từ 31/01/2010....

Ah hiểu rồi, mọi người đang tính bắt đầu từ ngày, mình lại cứ theo tháng mà phang, trật lất hết rồi.