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,326
Được thích
22,370
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:
(1) XuanNguyen82 đã giải bằng biến mảng ở bài B1 rồi mà, sao không tiếp tục vậy?

(Thực ra với CSDL trong file, tốc độ thực thi của fương thức AdvancedFilter & cách xài biến mảng đang là tương đương; Nhưng cách xài biến mảng là đán khuyết khích & ngợi khen!)

(2) Tại sao macro thứ 3 lại đi xóa 2 thiết kế trên trang tính dùng để lọc đi vậy? (Rồi sau đó, mỗi khi chạy macro 1 & macro 2 lại thiết kế lại)

(3)
Câu lệnh
Range(Range("AC5"), Range("AF65000").End(xlUp)).Copy

Có thể thay bằng
[AC5].CurentRegion.Ofset(1).Copy

Câu lệnh này hay hơn ở chổ, khi vùng trích lọc không có dữ liệu.

(4) XuanNguyen82 thử nhốt chung 3 macro trong 1 lúc rỗi xem sao!
 
Lần chỉnh sửa cuối:
Upvote 0
(4) XuanNguyen82 thử nhốt chung 3 macro trong 1 lúc rỗi xem sao![/QUOTE]

Mấy ngày ngồi xem các bạn học, thấy buồn. Mình cám ơn XuânNguyễn về tinh thần học tập nghiêm túc của bạn. Với vài tháng làm quen với VBA mình chưa thể tự viết Code được, nhưng mình thử nhốt 3 code của bạn xem sao. Không biết có đúng không nữa, các bạn và các thầy xem và góp ý.
 

File đính kèm

  • Bai2_BC_NgayXN1.rar
    68.8 KB · Đọc: 35
Lần chỉnh sửa cuối:
Upvote 0
ChanhTQ@ đã viết:
Trong giao dịch thông thường của 1 cơ sở i tế, thì không fải ngày nào hay tuần nào cũng nhập thuốc; Chuyện xuất thì có lẻ thường xuyên;

Macro của bạn sẽ gây lỡi, một khi trong thời hạn khào sát không có nhập hay xuất thuốc;

Bạn nên tiếp tục bẩy lỗi trong trường hợp này

Đáng khen cho XuanNguyen82 quá tích cực học tập luôn!

Em cảm ơn Thầy đã gợi ý, em cũng mới va chạm với VBA, còn có rất nhiều vấn đề cần học hỏi. Em sẽ nghiên cứu thêm về bài tập.
 
Upvote 0
Đề bài B3: Lập macro tính lượng tồn kho tháng giêng

Dưới đây là hình chụp từ trang tính 'DMuc' của CSDL bài trên

BT_B3.JPG

So với CSDL gốc, người ta đã thêm 1 số trường [12/11], [01/12], [02/12],. . . . về fía fải của CSDL
Nếu chú í kỹ ô nơi được kích hoạt, ta sẽ thấy thực chất các trường này là ngày đầu của 1 tháng nào đó.
Những người xây dựng CSDL này muốn chúng ta hiểu các trường này lập ra để tính tồn kho của cuối tháng đó; Hơn nữa, trường [12/11] là số liệu giả tưởng, mà các bạn nên nhập vô trước khi làm bài tập này.

Bài tập B3 có nội dung như sau:

Hảy viết macro điền số liệu vô cột (trường) [01/12] dựa trên số liệu các trang 'Nhap' & 'Xuat'

Gợi í: Các bạn cho chạy macro bài B2, nhưng với khoảng thời gian từ #1/1/2012# cho đến #31/1/2012# để số liệu hiện lên trang 'BC';
Từ số liệu đó làm cơ sở tính ra lượng tồn các mặt hàng trong tháng;

Chúc các bạn thành công.
 
Upvote 0
(1) XuanNguyen82 đã giải bằng biến mảng ở bài B1 rồi mà, sao không tiếp tục vậy?

(Thực ra với CSDL trong file, tốc độ thực thi của fương thức AdvancedFilter & cách xài biến mảng đang là tương đương; Nhưng cách xài biến mảng là đán khuyết khích & ngợi khen!)

(2) Tại sao macro thứ 3 lại đi xóa 2 thiết kế trên trang tính dùng để lọc đi vậy? (Rồi sau đó, mỗi khi chạy macro 1 & macro 2 lại thiết kế lại)

(3)
Câu lệnh
Range(Range("AC5"), Range("AF65000").End(xlUp)).Copy

Có thể thay bằng
[AC5].CurentRegion.Ofset(1).Copy

Câu lệnh này hay hơn ở chổ, khi vùng trích lọc không có dữ liệu.

(4) XuanNguyen82 thử nhốt chung 3 macro trong 1 lúc rỗi xem sao!

Em tiếp tục với bài tập B2. Kính nhờ các Thầy và các anh chị, các bạn chỉ bảo thêm ạ.

Mã:
Public Sub Xuan()
Dim Ws As Worksheet, I As Long, J As Long, K As Long, Arg(), Arr(1 To 65000, 1 To 6)
Dim TuNgay As Date, DenNgay As Date
    TuNgay = Sheets("BC").[E1].Value
    DenNgay = Sheets("BC").[E2].Value
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name = "Nhap" Or Ws.Name = "Xuat" Then
        Arg = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, 9).Value
        For I = 1 To UBound(Arg, 1)
            If Arg(I, 1) >= TuNgay And Arg(I, 1) <= DenNgay Then
                K = K + 1: Arr(K, 1) = K
                Arr(K, 2) = Arg(I, 1)
                If Ws.Name = "Nhap" Then
                    Arr(K, 3) = Arg(I, 4): Arr(K, 4) = Arg(I, 5)
                    Arr(K, 5) = Arg(I, 6)
                Else
                    Arr(K, 3) = Arg(I, 6): Arr(K, 4) = Arg(I, 7)
                    Arr(K, 6) = Arg(I, 8)
                End If
            End If
        Next I
    End If
Next
    With Sheets("BC").[A5].Resize(K, 6)
        .Resize(1000).ClearContents
        .Resize(1000).Borders.LineStyle = xlNone
        .Value = Arr
        .Borders.LineStyle = xlContinuous
        .Offset(, 1).Sort Key1:=Range("B5"), Order1:=xlAscending, Key2:=Range("C5"), Order2:=xlAscending
    End With
    If K Then
     Else
     Sheets("BC").[A5:F1000].ClearContents
     MsgBox "Khong co Nhap Xuat trong thoi gian nay", , "XUAN.NGUYEN82"
      End If
End Sub
 

File đính kèm

  • Bai2_BC_Ngay_2theo mang.zip
    105.7 KB · Đọc: 32
Upvote 0
Nếu khai báo thêm 1 biến tạm thì ta có thể viết gọn các câu lệnh này

Mã:
              If Ws.Name = "Nhap" Then
                    Arr(K, 3) = Arg(I, [COLOR="#FF0000"][B]4[/B][/COLOR]): Arr(K, 4) = Arg(I, [COLOR="#FF0000"] [B]5[/B][/COLOR])
                    Arr(K, 5) = Arg(I, [COLOR="#FF0000"][B]6[/B][/COLOR])
                Else
                    Arr(K, 3) = Arg(I, [COLOR="#FF0000"][B]6[/B][/COLOR]): Arr(K, 4) = Arg(I, [COLOR="#FF0000"]7[/COLOR])
                    Arr(K, 6) = Arg(I, [COLOR="#FF0000"][B]8[/B][/COLOR])
                End If


Ví dụ gợi í:

Dim Ofs As Long
If Ws.Name="Xuat" then Ofs = 2
. . . . .
 
Upvote 0
Mã:
              If Ws.Name = "Nhap" Then
                    Arr(K, 3) = Arg(I, [COLOR=#FF0000][B]4[/B][/COLOR]): Arr(K, 4) = Arg(I, [COLOR=#FF0000] [B]5[/B][/COLOR])
                    Arr(K, 5) = Arg(I, [COLOR=#FF0000][B]6[/B][/COLOR])
                Else
                    Arr(K, 3) = Arg(I, [COLOR=#FF0000][B]6[/B][/COLOR]): Arr(K, 4) = Arg(I, [COLOR=#FF0000]7[/COLOR])
                    Arr(K, 6) = Arg(I, [COLOR=#FF0000][B]8[/B][/COLOR])
                End If


Ví dụ gợi í:

Dim Ofs As Long
If Ws.Name="Xuat" then Ofs = 2
. . . . .
If
Arr(K, 3) = Arg(I, 4): Arr(K, 4) = Arg(I, 5)
Arr(K, 5) = Arg(I, 6)
-------------Túm lại là Arr(,x)=Arg(,x+1)
Nhưng Else
Arr(K, 3) = Arg(I, 6): Arr(K, 4) = Arg(I, 7)
-------------Thì Arr(,x)=Arg(,x+3)
Còn Arr(K, 6) = Arg(I, 8)
-------------Thì Arr(,x)= Arg(,x+2)
Gom nó vào Else như thế nào ta?
 
Upvote 0
if
arr(k, 3) = arg(i, 4): Arr(k, 4) = arg(i, 5)
arr(k, 5) = arg(i, 6)
-------------túm lại là arr(,x)=arg(,x+1)
nhưng else
arr(k, 3) = arg(i, 6): Arr(k, 4) = arg(i, 7)
-------------thì arr(,x)=arg(,x+3)
còn arr(k, 6) = arg(i, 8)
-------------thì arr(,x)= arg(,x+2)
gom nó vào else như thế nào ta?

If ... Then

ElseIf ... Then

Else

End If
 
Upvote 0
If ... Then

ElseIf ... Then

Else

End If
Việt vị rồi "bồ" ơi!
Ý tác giả gợi ý như vầy:
Ví dụ gợi í:

Dim Ofs As Long
If Ws.Name="Xuat" then Ofs = 2
. . . . .
Nghĩa là nếu Ws="Nhap" thì Ofs= 1. Else Ofs =2
Cứ thế thay vào cái này
If Ws.Name = "Nhap" Then
Arr(K, 3) = Arg(I, 4): Arr(K, 4) = Arg(I, 5)
Arr(K, 5) = Arg(I, 6)
Else
Arr(K, 3) = Arg(I, 6): Arr(K, 4) = Arg(I, 7)
Arr(K, 6) = Arg(I, 8)
End If
Mà hổng cần IF... ELSE gì cả.
Cứ "phan" Ofs vào:
Arr(k,X)=Arg(I,X+Ofs) là ..... xong??????????
 
Lần chỉnh sửa cuối:
Upvote 0
Việt vị rồi "bồ" ơi!
Ý tác giả gợi ý như vầy:

Nghĩa là nếu Ws="Nhap" thì Ofs= 1. Else Ofs =2
Cứ thế thay vào cái này

Mà hổng cần IF... ELSE gì cả.
Cứ "phan" Ofs vào:
Arr(k,X)=Arg(I,X+Ofs) là ..... xong??????????

Ai biểu hỏi làm sao thì trả lời như vậy nà! Ai biểu hỏi kiểu bác Cò làm chi!!!
 
Upvote 0
......hi

Hình như lớp học mấy hôm nay vắng vẻ quá ạ....
Mỗi em lên bảng...hic hic.

Lớp này rất được cộng đồng 2uan tâm (Thông qua số liệu truy cập hàng ngày)
Chỉ có điều rất nhiều người chưa mạnh dạn hay quen với kiểu topic này đang làm
Tất nhiên không loại trừ những người có vô vàn lí do khác để ghé xem qua. . . .
 
Upvote 0
Về những thè kho

Nói tới quản lý nhập, xuất & tồn, ta không thể không đếm xỉa tới những tờ thẻ kho.
Mình đã sưu tầm trên diễn đàn nào đó cái thẻ kho có hình như vầy:

TheKho.JPG

Nếu nghiên cứu & đối chiếu với nội dung trong trang'BC' mà ở các bài B1 & B2 ta đã đề cập đến thì chúng có họ hàng với nhau;

Theo mình Thẻ kho có nguồn góc từ 'BC'

(*) Nếu trên trang 'BC' chỉ liệt kê hoạt động của 1 mặt hàng

(*) Nếu ngày bắt đầu trong 'BC' là mốc đầu tiên để làm thẻ kho

Thì lúc đó 'BC' trở thành cái thẻ kho cho mặt hàng cụ thể nào đó.

Trở lại trang tính 'DMuc' ta có thể thấy điều này:
Cột [F] là lưu tồn của năm trước; Tiếp sau đó về bên fải liền kề là các cột/trường liệt kê số tồn từng tháng tăng dần cho đến tháng 12 của năm;

Ta có thể suy ra rằng, cách làm của cơ quan này là sau 1 năm hoạt động, 1 khi có số tồn cuối năm thì CQ đó sẽ xóa 12 cột kể từ cột [F] này đi
& như vậy số liệu tồn sẽ tiếp tục với niên hạn năm 2013 mới.
Và điều này sẽ sẩy ra: Thẻ kho lại lấy mốc bắt đầu từ 1/1/2013

Chúng ta cùng hình dung tiến trình như vậy để chuẩn bị sang bài tập B4 (sẽ có trong nay mai . . .)
 
Upvote 0
Dưới đây là hình chụp từ trang tính 'DMuc' của CSDL bài trên

View attachment 94154

So với CSDL gốc, người ta đã thêm 1 số trường [12/11], [01/12], [02/12],. . . . về fía fải của CSDL
Nếu chú í kỹ ô nơi được kích hoạt, ta sẽ thấy thực chất các trường này là ngày đầu của 1 tháng nào đó.
Những người xây dựng CSDL này muốn chúng ta hiểu các trường này lập ra để tính tồn kho của cuối tháng đó; Hơn nữa, trường [12/11] là số liệu giả tưởng, mà các bạn nên nhập vô trước khi làm bài tập này.

Bài tập B3 có nội dung như sau:

Hảy viết macro điền số liệu vô cột (trường) [01/12] dựa trên số liệu các trang 'Nhap' & 'Xuat'

Gợi í: Các bạn cho chạy macro bài B2, nhưng với khoảng thời gian từ #1/1/2012# cho đến #31/1/2012# để số liệu hiện lên trang 'BC';
Từ số liệu đó làm cơ sở tính ra lượng tồn các mặt hàng trong tháng;

Chúc các bạn thành công.

Hic, em làm vầy, có đúng ý thầy không ạ?

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim Rng As Range, RngA As Range, Cll As Range, K As Long, Nhap As Long, Xuat As Long
If Not Intersect(Target, [G1:Z1]) Is Nothing Then
    If Target.Columns.Count = 1 Then
    If Target.Rows.Count = 1 Then
        If Target <> "" Then
            With Sheets("BC")
            .[E1].Value = Target.Value
            .[E2].Value = DateSerial(Year(Target), Month(Target) + 1, 0)
            Set Rng = .Range(.[C5], .[C65536].End(xlUp)).Resize(, 5)
            End With
            With Sheets("DMuc")
            Set RngA = .Range(.[D2], .[D65536].End(xlUp))
                For Each Cll In RngA
                    K = K + 1
                    With Application.WorksheetFunction
                        Nhap = .SumIf(Rng, Cll, Rng.Offset(, 2))
                        Xuat = .SumIf(Rng, Cll, Rng.Offset(, 3))
                        Target.Offset(K).Value = Target.Offset(K, -1) + Nhap - Xuat
                    End With
                Next
            End With
        End If
    End If
    End If
End If
Set Rng = Nothing
Set RngA = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 

File đính kèm

  • Bai tap B3.rar
    75.9 KB · Đọc: 37
Lần chỉnh sửa cuối:
Upvote 0
Nhà em nộp bài theo Xuan.Nguyen. Bởi, nếu phải học một mình cũng ớn chẳng kém gì bị mắng. Mình cũng cố theo bạn cho hết bài.
 

File đính kèm

  • Bai3 loc ton kho 2.rar
    220.1 KB · Đọc: 60
Upvote 0
Nhà em nộp bài theo Xuan.Nguyen. Bởi, nếu phải học một mình cũng ớn chẳng kém gì bị mắng. Mình cũng cố theo bạn cho hết bài.


Có bạn học chung rất vui, bạn Kh biet giỏi thật đấy, nhìn cách bạn làm mà xuan.nguyen82 theo hông kịp.
Bầu chọn bạn Kh biet làm lớp trưởng nghen.
Cảm ơn bạn!
 
Upvote 0
Có bạn học chung rất vui

Cám ơn bạn, Bài toán phải giải theo hướng của bạn, nhưng mình không làm được. mình tham gia để bạn thấy có bạn cùng học thôi.
lớp này ko phải chỉ có 2 người học đâu, mà khá đông đó nhìn số người view xem, nhưng có lẽ do các thành viên khiêm tốn không nộp bài hoặc do học kém không có bài để nộp (số này có mình à nhe!) nên đành làm kháng giả chưa lên sân khấu được ...
 
Upvote 0
lớp này ko phải chỉ có 2 người học đâu, mà khá đông đó nhìn số người view xem, nhưng có lẽ do các thành viên khiêm tốn không nộp bài hoặc do học kém không có bài để nộp (số này có mình à nhe!) nên đành làm kháng giả chưa lên sân khấu được ...

Ẹc, mình cũng có biết mô tê gì đâu, cứ tham gia để mà nếu có sai thì có người sửa. Lần sau khỏi bị sai. Hihi.
Nhiều thành viên đáng để gọi là sư phụ trong lập trình rồi....
 
Upvote 0
Web KT
Back
Top Bottom