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)

  • Thread starter Thread starter SA_DQ
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia
8/6/06
Bài viết
14,712
Được thích
23,080
Nghề nghiệp
U80

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:
Em xin trả lời Bài 1

PHP:
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ị.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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ụ à!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Đề 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 --=0

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ú!
 
Upvote 0
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;
 
Upvote 0
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 ạ?
 
Upvote 0
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! --=0 --=0 --=0

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.

PHP:
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
 
Lần chỉnh sửa cuối:
Upvote 0
Anh QuangHai nếu [A1] = 1 thì sao nhỉ?
 
Upvote 0
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...
 
Upvote 0
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
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Đú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|. . .|||
 
Upvote 0
Đú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
PHP:
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
PHP:
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
PHP:
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
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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 .
 

File đính kèm

Upvote 0
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:
Mã:
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:
Mã:
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...
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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
 
Upvote 0
Trong code có đoạn:
Mã:
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:
Mã:
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.
 
Lần chỉnh sửa cuối:
Upvote 0
Đã 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
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
 
Upvote 0
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
PHP:
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
 
Lần chỉnh sửa cuối:
Upvote 0
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])

Filter.JPG
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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.
 
Lần chỉnh sửa cuối:
Upvote 0
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.
à, mình hiểu ý Quanghai rồi . Bài 1 bạn để +1 để học viên phải tìm, bài 2 không cho kết quả hiện đúng cột yêu cầu để học viên phải sử lý. Cám ơn bạn .
 
Upvote 0
Ở 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
|. . .|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ông ai mần hết thì thôi em ôn lại kiểu làm cơ bản lúc trước hay làm vậy
1. Khai báo cho có để không bị báo vàng vàng, vì chả hiểu lúc nào là range, lúc nào là as long...
2. Cứ từng cell mà copy, chả biết Union gì ráo. Vậy mà dễ học đấy, chứ chưa rành mấy cái này bày đặt lao vào mảng và CreateObject thì chả ra làm sao cả.
3. Còn sự kiện hả? Lúc em mới tham gia thì biết vẽ cái nút là mừng rồi
PHP:
Sub loc()
Dim i, Icolumn
Range("AA2:AD1000").ClearContents
  Icolumn = Range("G1:K1").Find([AE1]).Column
   For i = 2 To [B65536].End(xlUp).Row
      If Cells(i, Icolumn) <> "" Then
         [AA65536].End(3).Offset(1) = [AA65536].End(3).Offset(1).Row - 1
         [AB65536].End(xlUp).Offset(1) = Cells(i, 2)
         [AC65536].End(xlUp).Offset(1) = Cells(i, 3)
         [AD65536].End(xlUp).Offset(1) = Cells(i, 6)
      End If
   Next
End Sub

PS: Code này mà không tìm thấy dữ liệu tại AE1 là lỗi

Khi khá hơn chút thì em làm cách này cho gọn. Sau đó dùng Autofilter hoặc Sort để loại những dòng không có chữ X
PHP:
Sub loc_advanced()
Range([A1], [A65536].End(3)).Resize(, 11).AdvancedFilter 2, , [AA1:AE1]
End Sub
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Mình xin gợi í 1 cách khác, đó là AdvancedFilter

Các bạn chú í trong hình vẽ của đề bài sẽ thấy điều này:

Con trỏ đang kích hoạt ô [Ae2]; Mà trên thanh công thức ta thấy đánh dâu 'X'
Như vậy cụm [AE1:AE2] tạo thành vùng điều kiện lọc lý tưởng để chúng ta lọc từ vùng CSDL (Các cột từ [B:K]) sang các trường tại vùng [AB1:AD1]
Còn tại cột [AA] là ta cài sẵn công thức để đánh số thứ tự chỉ những dòng sau nó không rỗng.

Các bạn thử xem & chúc thành công.
 
Upvote 0
Em ham vui 1 tí nhé coi phải vậy không chị

Sub Test()
Range("AA2:AD16").ClearContents
Range("B1:K16").AdvancedFilter xlFilterCopy, Range("AE1:AE2"), Range("AB1:AD1")
With Range("AA2:AA" & Range("AB65000").End(xlUp).Row)
.FormulaR1C1 = "=ROW()-1"
.Value = .Value
End With


End Sub
 
Upvote 0
Các bạn chú í trong hình vẽ của đề bài sẽ thấy điều này:

Con trỏ đang kích hoạt ô [Ae2]; Mà trên thanh công thức ta thấy đánh dâu 'X'
Như vậy cụm [AE1:AE2] tạo thành vùng điều kiện lọc lý tưởng để chúng ta lọc từ vùng CSDL (Các cột từ [B:K]) sang các trường tại vùng [AB1:AD1]
Còn tại cột [AA] là ta cài sẵn công thức để đánh số thứ tự chỉ những dòng sau nó không rỗng.

Các bạn thử xem & chúc thành công.

Lúc khá hơn tí nữa thì làm theo cách sư phụ gợi ý, nhưng sẽ hơi khó hiểu cho các bạn mới làm quen. Người đã biết như Thầy thì thấy đơn giản, nhưng người mới thì .. than ôi ... sao khó thế. Em cũng đã nắm sơ sơ rồi mà vẫn còn ngơ ngơ lắm

PHP:
Sub loc_advancedfilter()
[AE2] = "X"
Range([A1], [A65536].End(3)).Resize(, 11).AdvancedFilter 2, [AE1:AE2], [AA1:AD1]
Range([AA2], [AA65536].End(3)) = [row(a:a)]
End Sub

Em ham vui 1 tí nhé coi phải vậy không chị
Người biết xài tuyệt chiêu này rõ ràng là cao thủ rồi...Hết chạy rồi nhá.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Người biết xài tuyệt chiêu này rõ ràng là cao thủ rồi...Hết chạy rồi nhá.
Cao thủ gì đâu anh ơi, em mới mò mẫm thôi ạ, hình như code trên cũng chưa đúng với yêu cầu anh ạ.

Có điều này em bắt gặp ở file bài tập mẫu là khi em click vào filter thử thì có các địa chỉ ở ô điều kiện, Chị Hải Yến quên xóa đi do test thử. Nên em căn cứ vào đó mà record macro thôi

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AE$1" Then
    Range("AA2:AD16").ClearContents
    Range("B1:K16").AdvancedFilter xlFilterCopy, Range("AE1:AE2"), Range("AB1:AD1")    
    With Range("AA2:AA" & Range("AB65000").End(xlUp).Row)            
        .FormulaR1C1 = "=ROW()-1"            
        .Value = .Value    
    End With
End If
End Sub
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Bài tập số 4: Điền diễn giải các tháng của 1 khoảng các ngày.

@$@!^%
@$@!^%
| A | B | C | D 1 ||Ngày bắt đầu:| 2/16/2012 |
2 ||Ngày Kết thúc:| 11/30/2012 |
3 ||||
4|TT | Tháng khảo sát | Chi fí | Ghi chú 5 |1| Tháng 02/2012 ||
6 |2| Tháng 03/2012 ||
7 |3| Tháng 04/2012 ||
8 |4| Tháng 05/2012 ||
9 |5| Tháng 06/2012 ||
10 |6| Tháng 07/2012 ||
11 |7| Tháng 08/2012 ||
12 |8| Tháng 09/2012 ||
13 |9| Tháng 10/2012 ||
14 |10| Tháng 11/2012 ||
15 ||/||

Macro có nhiệm vụ điền vô cột từ dòng thứ 5 trở xuống theo giá trị ngày bắt đầu & ngày kết thúc mà người dùng nhập vô tại 2 ô [C1:C2]

(Vì người dùng đã nhập vô [c1] là 16/02/2012 nên ta fải điền chuỗi đầu tiên là "tháng 02/2012"
& ngày cuối đã nhập là 30/11/2012, nên dòng cuối sẽ fải là "Tháng 11/2012")
Trong bảng, macro cần điền các chuỗi màu xanh.

Rất mong các bạn tiếp tục hưởng ứng.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Mã:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Mã:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub
Cho I chạy từ Dau tới Cuoi ( 2 tới 11) không ghi Step thì mặc định bước nhảy là 1_ Giá trị ban đầu là 2
Gán giá trị cho biến Thang= Dau ( là 2 )
Túm lại lần 1: ban đầu I = Thang
Sau mỗi vòng lặp:
(1) I tăng lên 1 ==> I = I +1

(2) Thang= Thang + 1
Từ túm lại lần 1 & (1) & (2) ==> "sui gia" I = Thang
Túm lại lần cuối: biến Thang ........."thờ ưa huyền" THỪA
Híc,
 
Upvote 0
Nếu người dùng muốn khảo sát số liệu của Q IV năm trước tới hết Q.I năm nay thì sao?

Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Xin XN82 suy nghỉ tiếp đi nha, nhưng chớ có căng quá!
 
Upvote 0
Bài tập 05: Tổng hợp từ CSDL vô bảng tại đề bài 4

Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#29)

CSDL có trong file đính kèm
}}}}}
--=0
}}}}}
(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Không ai mần hết thì thôi em ôn lại kiểu làm cơ bản lúc trước hay làm vậy
1. Khai báo cho có để không bị báo vàng vàng, vì chả hiểu lúc nào là range, lúc nào là as long...
2. Cứ từng cell mà copy, chả biết Union gì ráo. Vậy mà dễ học đấy, chứ chưa rành mấy cái này bày đặt lao vào mảng và CreateObject thì chả ra làm sao cả.
3. Còn sự kiện hả? Lúc em mới tham gia thì biết vẽ cái nút là mừng rồi
PHP:
Sub loc()
Dim i, Icolumn
Range("AA2:AD1000").ClearContents
  Icolumn = Range("G1:K1").Find([AE1]).Column
   For i = 2 To [B65536].End(xlUp).Row
      If Cells(i, Icolumn) <> "" Then
         [AA65536].End(3).Offset(1) = [AA65536].End(3).Offset(1).Row - 1
         [AB65536].End(xlUp).Offset(1) = Cells(i, 2)
         [AC65536].End(xlUp).Offset(1) = Cells(i, 3)
         [AD65536].End(xlUp).Offset(1) = Cells(i, 6)
      End If
   Next
End Sub

PS: Code này mà không tìm thấy dữ liệu tại AE1 là lỗi
Cám ơn bạn!mình thấy bài giải này của bạn dễ hiểu,đơn giản, các bài giải sau kiến thức học viên đòi hỏi phải cao hơn, code gọn hơn nhưng thao tác nhiều hơn . mình có vấn đề cần hỏi các bạn : code của "anh chang ngoc" bài #36 ở trên mình coppy về chạy không đúng yêu cầu của đề. Mình sai chỗ nào nhỉ ? tìm không ra . Chắc tại dốt quá;Tập tin đính kèm.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Mã:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub
Nếu bắt đầu từ 15/07/1983 đến hôm nay 30/11/2012 code chạy bỏ mất 6 dòng đầu, và kết quả là được 05 tháng ?
 
Upvote 0
Em thấy topic này rất hay, em cũng muốn tham gia để học hỏi. Em rất mong được các thầy, các anh chị, các bạn giúp đỡ ạ.
Em giải bài tập số 4 như sau:

Mã:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long, Thang As Long
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
Thang = Dau
For I = Dau To Cuoi
    STT = STT + 1
    Cells(I + 4, 1).Value = STT
    Cells(I + 4, 2).Value = "Thang " & Format(Thang, "00") & "/2012"
    Thang = Thang + 1
Next I
End With
End Sub
Chỉnh sửa lại đoạn code của xuannguyen một chút.
1. Bỏ biến tháng do thừa như bác concogia phân tích
2. Thêm điều kiện mỗi lần chạy code thì xóa dử liệu cũ không thì dử liệu chồng chéo.
3. Sửa lại điều kiện như chạy dử liệu dòng đầu tiên là dòng thứ 5.
PHP:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, I As Long
Range("A5:B6500").Clear
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
For I = Dau To Cuoi   
 STT = STT + 1    
Cells(STT + 4, 1).Value = STT  
  Cells(STT + 4, 2).Value = "thang " & Format(I, "00") & "/2012"
Next I
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Leonguyez ơi, Sao lại 15/07/1983 nhỉ ? mình không hiểu .
 
Lần chỉnh sửa cuối:
Upvote 0
Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#41)

CSDL có trong file đính kèm
}}}}}
--=0
(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)
Hic hic bài này em làm thêm cột phụ, với lại năm chưa khắc phục được em đưa lên để các thầy chỉ thêm ạ.
PHP:
Public Sub Xuan()
Dim Dau As Long, Cuoi As Long, STT As Long, i As Long
Range("A5:B6500").Clear
With Sheet1
Dau = Month(.[C1])
Cuoi = Month(.[C2])
For i = Dau To Cuoi    
STT = STT + 1   
Cells(STT + 4, 1).Value = STT  
Cells(STT + 4, 2).NumberFormat = """Tháng ""00""/2012"""   
 Cells(STT + 4, 2).Value = i    
Cells(STT + 4, 3).Value = Application.SumIf(Sheet4.[J:J], Cells(STT + 4, 2), Sheet4.[e:e])
Next i
End With
End Sub
Em định sử dụng hàm sumproduct luôn mà ko làm được.
 

File đính kèm

Upvote 0
Sao bạn lại dùng Excel Function? Nếu Excel Function thì có hàm Edate cũng có thể giải quyết được đề bài đấy.
Ở đây nếu suy nghĩ theo kiểu 1 năm có 12 tháng thì sao nhỉ...?
 
Upvote 0
Do Leonguyenz gõ nhầm thôi.15/7/2012 ấy mà.
Code của XN gán dữ liệu vào dòng I+4 nên nếu bắt đầu bằng tháng 7 thì dòng đầu là dòng 11, bỏ trống từ dòng 5-10(6 dòng).
Cám ơn thày Ba Tê. vì bài giải nào của các bạn, nhà em cũng tải về để học hỏi, bài nào vướng, hoặc không hiểu phải hỏi lại cho rõ thôi . Bạn Leonguyenz mình không có ý khác đâu .
 
Upvote 0
Xin XN82 suy nghỉ tiếp đi nha, nhưng chớ có căng quá!

(Tình hình là vết mổ của em nó .."căng" thôi ạ....hihi. Em cũng "nhồi" kiến thức từ từ, dần dần....Nên các thầy ra đề cho học sinh "mẫu giáo" như em có thể giải được í ạ. Những bài khó là em...chạy...hic hic).

Trong trường hợp giả sử khảo sát số liệu từ quý II năm 2011 đến hết quý I năm 2012 (số liệu giả định):

Mã:
Public Sub Xuan2()
Dim Dau As Long, Cuoi As Long, I As Long, SoThang As Long
With Sheet1
.[A5:B1000].ClearContents
Dau = DateSerial(Year(.[C1]), Month(.[C1]), 1)
Cuoi = DateSerial(Year(.[C2]), Month(.[C2]), 1)
SoThang = DateDiff("m", Dau, Cuoi) + 1
For I = 1 To SoThang
    .Cells(I + 4, 1).Value = I
    .Cells(I + 4, 2).Value = "Thang " & Format(DateSerial(Year(Dau), Month(Dau) + I - 1, 1), "mm/yyyy")
Next I
End With
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bài này em thêm cột phụ, với lại năm chưa khắc phục được em đưa lên để các thầy chỉ thêm ạ.
Em định sử dụng hàm Sumproduct luôn mà ko làm được.

Bạn thử theo hướng DSUM() xem sao
 
Upvote 0
Góp vui và chia vui với mọi người tí, nhờ học được cách hay của XN82 nên cũng chế ra được 1 kiểu khác
PHP:
Sub Ngay_Thang()
Dim I As Long, SoThang As Long
   With ActiveSheet
      .[A5:B1000].ClearContents
      SoThang = DateDiff("m", .[C1], .[C2]) + 1
      For I = 1 To SoThang
         .Cells(I + 4, 1).Value = I
         .Cells(I + 4, 2) = "Tháng " & Format(DateAdd("m", I - 1, .[C1]), "mm-yyyy")
      Next I
   End With
End Sub
 
Upvote 0
Chờ mãi không thấy ai lên bảng, nhà em lên vậy. đáp án không hay lắm, mọi người góp ý .
Kiểm tra lại, quyên không ráp bài 2 của XuanNguyen82 nên chỉ được 1 năm . nói chung làm sao lọc được cả tháng và năm thì ... Mình tắc tỵ rồi; cái hũ bã đậu của mình chỉ được cái nhiều tóc, chán thật
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn với SAODOINGOI_XD cùng đi 1 hướng, đó là xài =SUMIF()

Chờ mãi không thấy ai lên bảng, nhà em lên vậy. đáp án không hay lắm, mọi người góp ý.

/(/hưng cũng như SAODOINGOI_XD, bạn vẫn chưa xử lí được việc khảo sát số liệu trên 1 năm;

Hơn nữa, như đề bài, các bạn còn fải thấy rằng, số liệu khảo sát có khi chỉ là 1 vài ba tuần mà thôi!

Lúc đó SUMIF() của các bạn fá sản.


Để khỏi bị tan gia bại sản, mình nghỉ ra cách như sau:

Cần viết hàm người dùng biến đổi số liệu kiểu ngày nào đó trong thế kỷ này (như 03/08/2012) biểu thỉ chỉ bằng mả có độ dài là 3, như XYZ,

Mà trong đó X biểu thị cho năm, như A biểu thị cho năm 2000, B-> 2001,. . . .

Y biểu thị cho tháng; Thêm nữa ta lấy trọn 36 ký tự & ký số để biểu thị cho 36 tháng của 3 năm liền kề nhau. Chi vậy?Trả lời: Để với 26 chữ cái, ta biểu diễn được 26 *3 số năm của thế kỷ này.

Qua đoạn văn vừa rồi, chắc mã kí tự Z biểu diễn 31 ngày trong 1 tháng kia không mấy khó khăn với các bạn, fải không?

Mình cho rằng cách này sẽ giúp ta dùng hàm SUMIF() 1 cách thuận tiên.

. . .
 
Lần chỉnh sửa cuối:
Upvote 0
/(/hưng cũng như SAODOINGOI_XD, bạn vẫn chưa xử lí được việc khảo sát số liệu trên 1 năm;

Hơn nữa, như đề bài, các bạn còn fải thấy rằng, số liệu khảo sát có khi chỉ là 1 vài ba tuần mà thôi!

Lúc đó SUMIF() của các bạn fá sản.


Để khỏi bị tan gia bại sản, mình nghỉ ra cách như sau:

Cần viết hàm người dùng biến đổi số liệu kiểu ngày nào đó trong thế kỷ này (như 03/08/2012) biểu thỉ chỉ bằng mả có độ dài là 3, như XYZ,

Mà trong đó X biểu thị cho năm, như A biểu thị cho năm 2000, B-> 2001,. . . .

Y biểu thị cho tháng; Thêm nữa ta lấy trọn 36 ký tự & ký số để biểu thị cho 36 tháng của 3 năm liền kề nhau. Chi vậy?Trả lời: Để với 26 chữ cái, ta biểu diễn được 26 *3 số năm của thế kỷ này.

Qua đoạn văn vừa rồi, chắc mã kí tự Z biểu diễn 31 ngày trong 1 tháng kia không mấy khó khăn với các bạn, fải không?

Mình cho rằng cách này sẽ giúp ta dùng hàm SUMIF() 1 cách thuận tiên.

. . .
Cám ơn gợi ý của thầy. Nhà em sẽ cố gắng chạy theo các bạn.
 
Upvote 0
Góp vui 2 cách
Cách 1:
PHP:
Sub test1()
Dim i As Long, j As Long, dk1, dk2
Sheet2.[D8:D100].ClearContents
For i = 8 To Sheet2.[C65536].End(3).Row
   dk1 = Replace(Right(Sheet2.Cells(i, 3), 7), "/", "-")
   For j = 4 To Sheet1.[a65536].End(3).Row
      dk2 = CStr(Format(Sheet1.Cells(j, 1), "mm-yyyy"))
      If dk1 = dk2 Then
         Sheet2.Cells(i, 4) = Sheet2.Cells(i, 4) + Sheet1.Cells(j, 5)
      End If
   Next
Next
End Sub
Cách 2:
PHP:
Sub test2()
Dim dl(), i As Long, kq(), j As Long, dk1 As String, dk2 As String
Sheet2.[D8:D100].ClearContents
kq = Sheet2.Range(Sheet2.[B8], Sheet2.[b65536].End(3)).Resize(, 3).Value
dl = Sheet1.Range(Sheet1.[A4], Sheet1.[a65536].End(3)).Resize(, 5).Value
For i = 1 To UBound(kq)
   dk1 = Replace(Right(kq(i, 2), 7), "/", "-")
   For j = 1 To UBound(dl)
      dk2 = CStr(Format(dl(j, 1), "mm-yyyy"))
      If dk1 = dk2 Then
         kq(i, 3) = kq(i, 3) + dl(j, 5)
      End If
   Next
Next
Sheet2.[B8].Resize(i - 1, 3) = kq
End Sub
 
Upvote 0
(Tình hình là vết mổ của em nó .."căng" thôi ạ....hihi. Em cũng "nhồi" kiến thức từ từ, dần dần....Nên các thầy ra đề cho học sinh "mẫu giáo" như em có thể giải được í ạ. Những bài khó là em...chạy...hic hic).

Trong trường hợp giả sử khảo sát số liệu từ quý II năm 2011 đến hết quý I năm 2012 (số liệu giả định):

Mã:
Public Sub Xuan2()
Dim Dau As Long, Cuoi As Long, I As Long, SoThang As Long
With Sheet1
.[A5:B1000].ClearContents
Dau = DateSerial(Year(.[C1]), Month(.[C1]), 1)
Cuoi = DateSerial(Year(.[C2]), Month(.[C2]), 1)
SoThang = DateDiff("m", Dau, Cuoi) + 1
For I = 1 To SoThang
    .Cells(I + 4, 1).Value = I
    .Cells(I + 4, 2).Value = "Thang " & Format(DateSerial(Year(Dau), Month(Dau) + I - 1, 1), "mm/yyyy")
Next I
End With
End Sub
Cám ơn bạn, mình mụ mẫm thế nào khi mở file của bạn cứ tìm module, bạn đã đổi mầu D5 mà mình không để ý . Đồ cũ chạy ỳ ạch thế đấy, rõ chán!
 
Lần chỉnh sửa cuối:
Upvote 0
Các thầy và các anh chị có bài nào dễ hơn từ A,B,C để cho em tham gia với ạ.
 
Upvote 0
Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#41)

CSDL có trong file đính kèm
}}}}}
--=0
}}}}}
(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)
Chị ơi, nếu những tháng không có phát sinh chi phí thì nên loại nó ra luôn không?
 
Upvote 0
Loại ra cũng tốt, nhưng để sau đi

Nếu những tháng không có phát sinh chi phí thì nên loại nó ra luôn không?

Giờ thì cho nó hiện số 0, hay dòng: "Không fát sinh" là OK rồi!

Các thầy và các anh chị có bài nào dễ hơn từ A,B,C để cho em tham gia với ạ.

Vậy qua công việc hàng ngày bạn có:


(*) Gặp trở ngại gì cần đến VBA giúp không?

(*) Lâu nay xài công thức, giờ muốn tìm đến VBA không?

(*) . . .

Bạn cứ đưa lên đây lnhư là 01 bài tập vậy!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Vậy qua công việc hàng ngày bạn có:

(*) Gặp trở ngại gì cần đến VBA giúp không?

(*) Lâu nay xài công thức, giờ muốn tìm đến VBA không?

(*) . . .

Bạn cứ đưa lên đây lnhư là 01 bài tập vậy!

Em chỉ mới làm quen với VBA, từ những cấu trúc đơn giản, ngắn, dễ hiểu mà em tin chắc rất nhiều bạn muốn học như vậy.
Cho bài tập từ những cấu trúc Sub. End sub đơn giản.

Sub ()
Dim....
For Each...
If...
End If
Next
End Sub
-Những đề dạng ngắn ngắn như vậy cho lớp đàn em chúng em dễ hiểu, mới mò mẫm VBA thôi ạ. Mấy đề thứ 4,5 là phải học "tiểu học" VBA mới giải được ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
If HYen17.Sex= "Male" Then
HYen17.Age= 17
Elseif HYen17.Sex= "Female" Then
HYen17.Age= 71
Else
HYen17.Age= (17 + 71) \ 2
End If

PS: CN Spam tí, MOD xoá hộ bài khi hết ngày
Xóa làm gì?
Đây là một dạng bài tập đơn giản mà bạn "Như Đã Dấu Yêu" muốn xem đấy.
Nên thêm cho chắc ăn:
If HYen17.Sex= "Male" Then
HYen17.Age= 17
Elseif HYen17.Sex= "Female" Then
HYen17.Age= 71
Else
HYen17.Age= (17 + 71) \ 2
End If
[IV65536].value="Old man Ẹc Ẹc..."
 
Upvote 0
Em chỉ mới làm quen với VBA, từ những cấu trúc đơn giản, ngắn, dễ hiểu mà em tin chắc rất nhiều bạn muốn học như vậy.
Cho bài tập từ những cấu trúc vòng lặp đơn giản.

-Những đề dạng ngắn ngắn như vậy cho lớp đàn em chúng em dễ hiểu, mới mò mẫm VBA thôi ạ. Mấy đề thứ 4,5 là phải học "tiểu học" VBA mới giải được ạ.

Thực ra bài tập 4 ta cũng có thể dùng vòng lặp theo từng ngày; Hễ khác tháng thì ta thêm 1 dòng!

/(hông tin bạn nhờ Ba tê hay cha 2uangHai đưa lên cho mà coi!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Em bập bõm ado như sau

Mã:
Sub TongCong()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 8.0;HDR=No;"";"
    .Open
End With
    lsSQL = "SELECT 'Tháng ' & Format(F1,'mm-yyyy') & ':', Sum(F5) " & _
             "FROM [ChiFi$A3:E1397] " & _
             "WHERE F1 Between #" & Format(DateSerial(Year(Sheet2.[d4]), Month(Sheet2.[d4]), Day(Sheet2.[d4])), "mm/dd/yyyy") & _
                                             "# AND #" & Format(DateSerial(Year(Sheet2.[d5]), Month(Sheet2.[d5]), Day(Sheet2.[d5])), "mm/dd/yyyy") & "# " & _
             "GROUP BY Format(F1,'mm-yyyy'), Year(F1) " & _
             "ORDER BY Year(F1);"
    lrs.Open lsSQL, cnn, 3, 1
With Sheet2
   .[B8:E100].ClearContents
   .[C8].CopyFromRecordset lrs
End With
With Sheet2.Range("B8:B" & Sheet2.Range("C65000").End(xlUp).Row)
   .FormulaR1C1 = "=ROW()-7"
   .Value = .Value
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing


End Sub
 
Upvote 0
Cơ quan nọ cần tổng hợp số liệu chi fí của các tháng để ghi vô bảng mẫu tại bài 4 (#41)

CSDL có trong file đính kèm
}}}}}
--=0
}}}}}
(Bài này có thể có nhiều cách làm từ dễ đến khó; Mong các bạn tiếp tục hưởng ứng)

Em làm theo cách hiểu của em như sau (trình độ mầm non VBA).
Bài tập 5

Mã:
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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em bập bõm ado như sau

Mã:
Sub TongCong()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & ThisWorkbook.FullName & _
                        ";Extended Properties=""Excel 8.0;HDR=No;"";"
    .Open
End With
    lsSQL = "SELECT 'Tháng ' & Format(F1,'mm-yyyy') & ':', Sum(F5) " & _
             "FROM [ChiFi$A3:E1397] " & _
             "WHERE F1 Between #" & Format(DateSerial(Year(Sheet2.[d4]), Month(Sheet2.[d4]), Day(Sheet2.[d4])), "mm/dd/yyyy") & _
                                             "# AND #" & Format(DateSerial(Year(Sheet2.[d5]), Month(Sheet2.[d5]), Day(Sheet2.[d5])), "mm/dd/yyyy") & "# " & _
             "GROUP BY Format(F1,'mm-yyyy'), Year(F1) " & _
             "ORDER BY Year(F1);"
    lrs.Open lsSQL, cnn, 3, 1
With Sheet2
   .[B8:E100].ClearContents
   .[C8].CopyFromRecordset lrs
End With
With Sheet2.Range("B8:B" & Sheet2.Range("C65000").End(xlUp).Row)
   .FormulaR1C1 = "=ROW()-7"
   .Value = .Value
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing


End Sub
Ái da!
"Anh Chàng Ngốc" này mà "ngốc" cái nỗi gì "Chời".
ADO "sáng lòe" luôn.
"Vua nước Sở một hôm lòng thanh thản,
Cởi long bào giả dạng một thường dân..."
Bộ tính xem cua đực cua cái làm gì sao "Chời".
http://www.youtube.com/watch?v=N6R7qENQfdY

Em làm theo cách hiểu của em như sau (trình độ mầm non VBA).
Bài tập 5

Mã:
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
Hổng dám mầm non đâu.
"Huốt" mẫu giáo "gồi".
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Cái này bây giờ mới thấy
Mã:
    Thang = [COLOR=#ff0000]DateSerial[/COLOR](Year(Dau), Month(Dau) + I - 1, 1)
 
Upvote 0
Em làm theo cách hiểu của em như sau (trình độ mầm non VBA).
Bài tập 5

Mã:
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.
 
Upvote 0
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.

Mã:
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
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Sửa lại bài 5.

Mã:
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.

 
Upvote 0
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.
 
Upvote 0
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!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Đã 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.
 
Upvote 0
Đã 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
 
Upvote 0
Đã 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?
 
Upvote 0
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

}}}}}
--=0
}}}}}
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!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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 .
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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.
PHP:
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
 
Upvote 0
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.
PHP:
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.
PHP:
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.
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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
 
Upvote 0
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:
PHP:
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
 
Lần chỉnh sửa cuối:
Upvote 0
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:
PHP:
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....
 
Upvote 0
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.
Nếu...Nếu...Nếu mà xài WF thì cứ lập công thức, xong "gồi" Record Macro như vầy xem (chưa có cột ghi chú):
PHP:
Sub GPE()
Dim I As Long, SoThang As Long
   With ActiveSheet
      .[B8:E1400].ClearContents
      SoThang = DateDiff("m", .[D4], .[D5]) + 1
      For I = 1 To SoThang
         .Cells(I + 7, 2).Value = I
         .Cells(I + 7, 3) = Format(DateAdd("m", I - 1, .[D4]), "mm/yyyy")
      Next I
        .Range(.[C8], [C65000].End(xlUp)).Offset(, 1) = _
        "=SUMIF(ChiFi!R4C1:R10000C1,"">="" &MAX(RC[-1],R4C4),ChiFi!R4C5:R10000C5) -SUMIF(ChiFi!R4C1:R10000C1,"">="" & IF(R[1]C3="""",R5C4+1,R[1]C3),ChiFi!R4C5:R10000C5)"
        .Range(.[D8], [D65000].End(xlUp)).Value = .Range(.[D8], [D65000].End(xlUp)).Value
   End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
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í?
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 .

Đêm làm bài tập toét cả mắt, sáng vợ lại gọi dậy sớm, nhà em tức cảnh sinh tình :

GPE,GPE,lại GPE
Sáng ra vợ gọi, mắt cay sè
Thương ai, nhớ ai, mà không ngủ ?
Thương nhớ gì đâu...rặt CODE.

Cám ơn các thầy, cám ơn các bạn !
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Chuyến này chắc là không theo nổi bài này, bài tập đơn giản cho người bắt đầu mà khó quá, chắc em phải học lại lớp vỡ lòng.
 
Upvote 0
Bài tập 07: Thêm dòng tính tổng sau khi đã thống kê số liệu (Bài này dễ nè bạn.)

Chuyến này chắc là không theo nổi bài này, "Bài tập đơn giản cho người bắt đầu" mà khó quá, chắc em phải học lại lớp vỡ lòng.

Sau khi thống kê số liệu theo yêu cầu của các bài trước (Xem tại bài #27), ta cần thêm dòng tổng cộng, như sau

@$@!^%
| A | B | C | D 1 ||Ngày bắt đầu:| 2/16/2012 |
2 ||Ngày Kết thúc:| 11/30/2012 |
3 ||||
4|TT | Tháng khảo sát | Chi fí | Ghi chú 5 |1| Tháng 02/2012 ||
6 |2| Tháng 03/2012 ||
7 |3| Tháng 04/2012 ||
8 |4| Tháng 05/2012 ||
9 |5| Tháng 06/2012 ||
|. .|. . . . . .||
|. .|. . . ||
|10| Tháng 11/2012 ||
||||
|| Tổng cộng: | ###.###.### |

Các bạn có thể giả lập số liệu từ [C5:C14] rồi viết macro theo iêu cầu của đề bài

'
'
'
'

 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Bài 7: Đóng góp thêm một cách
PHP:
Sub tong()
Set sw = Worksheets("TH")  
Sheets("TH").Activate          
 iRow = sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row          
 Range("c" & iRow + 1).Formula = "=SUM(C" & iRow & ":C" & (5) & ")"
End Sub
 
Upvote 0
Bài 7: Đóng góp thêm một cách
PHP:
Sub tong()
Set sw = Worksheets("TH")  
Sheets("TH").Activate          
 iRow = sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row          
 Range("c" & iRow + 1).Formula = "=SUM(C" & iRow & ":C" & (5) & ")"
End Sub

Vui lòng giải thích rõ câu lệnh
Mã:
[FONT=Courier New][COLOR=#0000bb]iRow [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]sw[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Rows[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Count[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]3[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]1[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]0[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Row[/COLOR][/FONT]

Xin cm ơn
 
Upvote 0
Vui lòng giải thích rõ câu lệnh
Mã:
[FONT=Courier New][COLOR=#0000bb]iRow [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]sw[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#ff0000]Rows.Count[/COLOR][COLOR=#007700], [/COLOR][COLOR=#ff0000]3[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]End[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]xlUp[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Offset[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]1[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]0[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Row[/COLOR][/FONT]

Xin cm ơn

Rows.Count là Mút chỉ ở tận cùng bảng tính ---> Dòng cuối luôn
3 <==> Cột C
Cells(Rows.Count, 3) <===> Dòng cuối của cột C
sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row ---> Từ "địa ngục", bắn lên đến ô cuối cùng có dữ liệu, xong "dze đít" xuống 1 dòng
Tóm lại iRow chính là dưới dòng cuối cùng có dữ liệu của cột C đúng 1 dòng
 
Upvote 0
Đề nghị TVXDGT;456055 bở sung cụm từ "Tổng cộng" cái nha

Bài 7: Đóng góp thêm một cách

Gợi í:
(1) Có thể lấy từ ô đâu đó ở trang tính nào đó mà bỏ vô cái nha.

(2) Nghiên cứu macro này xem nó làm gì đây:

PHP:
Option Explicit
Sub gpeName()
 Dim Ten
 For Each Ten In ThisWorkbook.Names
    If Mid(Ten.Value, 3, 1) = "T" And Mid(Ten.Value, 5, 2) = "ng" Then
        MsgBox Mid(Ten.Value, 3, 9):            Exit For
    End If
 Next Ten
End Sub

./.
 
Lần chỉnh sửa cuối:
Upvote 0
Rows.Count là Mút chỉ ở tận cùng bảng tính ---> Dòng cuối luôn
3 <==> Cột C
Cells(Rows.Count, 3) <===> Dòng cuối của cột C
sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row ---> Từ "địa ngục", bắn lên đến ô cuối cùng có dữ liệu, xong "dze đít" xuống 1 dòng
Tóm lại iRow chính là dưới dòng cuối cùng có dữ liệu của cột C đúng 1 dòng
iRow = sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Nếu vậy thì có cần .Row không thầy?
Vì em thy đã xác đnh đưc Cell ri?
Em cm ơn

 
Upvote 0
Tình hình là em "cá Đuối" rồi. Có ai kéo giùm em lên với ạ.
Em mới làm quen thôi, các thầy và các anh chị dắt tay em từng bước một, hic, bước cao quá em ...bước hụt...

Đuối sức thì phục hồi, lỡ ăn "cá đuối" thì phải xực thêm "cá hồi" nữa là khỏe lại thôi.

iRow = sw.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Nếu vậy thì có cần .Row không thầy?
Vì em thy đã xác đnh đưc Cell ri?
Em cm ơn


Bạn đừng nhầm lẫn giữa địa chỉ ô (address) và hàng thứ (row) của nó chứ!

Khi bạn chọn, truy vấn một địa chỉ thì không phải thêm Row, nhưng nếu bạn muốn xác định địa chỉ ô đã chọn đó nằm ở hàng thứ mấy thì bạn lại cho "râu" vào.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Gợi í:
(1) Có thể lấy từ ô đâu đó ở trang tính nào đó mà bỏ vô cái nha.
./.
PHP:
Sub tong()
Set sw = Worksheets("TH")  
Sheets("TH").Activate         
  iRow = sw.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row        
   sw.Cells(iRow + 1, 2).Select   
 Selection.FormulaR1C1 = "=tongcong"   
 Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"    
Selection.Font.Bold = True    
With Selection.Font      
  .Color = -16776961        
.TintAndShade = 0   
 End With          
 Range("c" & iRow + 1).Formula = "=SUM(C" & iRow & ":C" & (5) & ")"
End Sub
 

File đính kèm

Upvote 0
Gợi í cho những bạn chưa làm bài tập 7 đây nè:

Ta để sẵn "Tổng cọng" ở ô [B999] & công thức =Sum("C5:C997") ở [C999];

Như vậy ta chỉ việc viết vài dòng lệnh ẩn các hàng không cần thiết đi mà thôi;

Bạn nào thử xem sao(!)
 
Lần chỉnh sửa cuối:
Upvote 0
Ta để sẵn "Tổng cọng" ở ô [B999] & công thức =Sum("C5:C997") ở [C999];

Như vậy ta chỉ việc viết vài dòng lệnh ẩn các hàng không cần thiết đi mà thôi;

Bạn nào thử xem sao(!)
PHP:
Sub tong2()
Application.ScreenUpdating = False
On Error Resume Next
Selection.AutoFilter
[B5:B997].SpecialCells(4).EntireRow.Hidden = True
Application.ScreenUpdating = True
Selection.AutoFilter
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Sửa lại bài 5.

Mã:
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

Nàng thơ viết code....vừa làm thơ vừa viết code được chăng?
mà sao mình test thử code này không chạy nhỉ?
 
Upvote 0
PHP:
Sub tong2()
Application.ScreenUpdating = False
On Error Resume Next
Selection.AutoFilter
[B5:B997].SpecialCells(4).EntireRow.Hidden = True
Application.ScreenUpdating = True
Selection.AutoFilter
End Sub

Thủ tục này hơi lạ hen! Sao lại Selection.AutoFilter ở dòng đầu và dòng cuối nhỉ? Tác dụng của nó là gì và nó lọc cái gì vậy?
 
Upvote 0
Thủ tục này hơi lạ hen! Sao lại Selection.AutoFilter ở dòng đầu và dòng cuối nhỉ? Tác dụng của nó là gì và nó lọc cái gì vậy?
Tôi đã text thử code của bạn Tvxdgt, Selection.AutoFilter ở dòng cuối có tác dụng thực hiện lệnh nhưng không hiện Nút AutoFilter . Và phải thêm dòng lệnh Selection.EntireRow.Hidden = False trước đoạn code trên để trả lại AutoFilter trước khi thay đổi, nếu điều kiện sau nhiều dữ liệu hơn lần trước đó . các bạn kiểm tra, không biết có đúng không nữa .
Kèm theo tập tin
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Tôi đã text thử code của bạn Tvxdgt, Selection.AutoFilter ở dòng cuối có tác dụng thực hiện lệnh nhưng không hiện Nút AutoFilter . Và phải thêm dòng lệnh Selection.EntireRow.Hidden = False trước đoạn code trên để trả lại AutoFilter trước khi thay đổi, nếu điều kiện sau nhiều dữ liệu hơn lần trước đó . các bạn kiểm tra, không biết có đúng không nữa .
Kèm theo tập tin

Trường hợp của bạn (gần như hợp lý):

Mã:
    With Rows("8:998")[COLOR=#ff0000][B].Select[/B][/COLOR]
        Selection.EntireRow.Hidden = False
    End With

Tôi nói như vậy là vì bạn có chỗ để Select rồi từ đó mới Selection. Tức là đã xác định rõ vị trí đã chọn rồi thì cứ thế mà "quất" thôi. Còn thủ tục kia không có "nơi nương tựa" nên bạ đâu là "quất" đó, tại ngay cái ô đang Active/ select bất kỳ trên sheet.

Thủ tục trên của bạn lẽ ra chỉ cần như vầy:

Mã:
    Rows("8:998").Select
    Selection.EntireRow.Hidden = False

Không cần quýt cam gì hết

Nhưng tốt hơn là như vầy:

Mã:
    Rows("8:998").EntireRow.Hidden = False

Bạn thử sửa với những dạng "cam quýt" của toàn bộ thủ tục của bạn như tôi hướng dẫn xem có phải nhanh hơn và gọn hơn hay không!
 
Upvote 0
Cám ơn bạn Nghĩa, mình viết được thế đã đủ "tắc thở", Thấy nó chạy, không chống lại là mừng rồi . Học thêm được món bỏ "cam quýt" của bạn, chạy cho nhanh . Mình nhớ rồi ! xin cám ơn bạn .
 
Lần chỉnh sửa cuối:
Upvote 0

Bài viết mới nhất

Back
Top Bottom