Các câu đố, bài tập nhằm ôn tập & bổ sung kiến thức căn bản VBA

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,590
Được thích
16,653
Giới tính
Nam
Với tinh thần chơi mà học, học mà chơi, nên tôi đã mở ra topic này, hy vọng các thành viên tham gia, nhất là các thành viên mới biết về VBA.

Sau đây là câu hỏi đầu tiên:

Câu hỏi 1: Bằng phương pháp nào nhanh nhất để tìm ra ô nào trong một cột chứa một điều kiện.

Tôi có 1 file Excel 2007, với cột A, từ A1 đến A1048576 đều có giá trị.

Bằng phương pháp nào nhanh nhất (dùng mảng, dùng For Each v.v...) để tìm ra ô nào trong cột A chứa chữ "Nghia", đồng thời với ô ở cột B tương ứng nhập giá trị "OK" vào đó?

Ví dụ tìm thấy trong ô A2 có giá trị là "Nghia" thì ô B2 nhập vào "OK".

Hiện tại, đáp án nhanh nhất mà tôi có được đã gửi mail riêng (nhằm ghi lại thời gian gửi, để tránh nói ăn gian).

Để tiện việc theo dõi các câu đố, các bài tập tôi đã tạo ra topic này các bạn click vào đây:

Các link của topic "Các câu đố, bài tập nhằm ôn tập & bổ sung kiến thức căn bản VBA"
 

File đính kèm

  • DoVuiCanBan.rar
    1.3 MB · Đọc: 618
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Em sửa lại code câu b như vậy, cũng không khác so với code trước, nhưng tạm thời là chưa nghĩ ra cách khác:
Mã: 
Private Sub CommandButton3_Click()
Dim I As Long, J As Long
Columns("E:F").Clear
    For I = 1 To 56 Step 2
        J = (I + 1) / 2
        Cells(J, 5).Interior.ColorIndex = I + 1
        Cells(J, 6) = I + 1
    Next I
End Sub
 

File đính kèm

  • Color.xls
    59 KB · Đọc: 13
Upvote 0
leonguyenz đã viết:
Em sửa lại code câu b như vậy, cũng không khác so với code trước, nhưng tạm thời là chưa nghĩ ra cách khác:
Mã: 
Private Sub CommandButton3_Click()
Dim I As Long, J As Long
Columns("E:F").Clear
    For I = 1 To 56 Step 2
        J = (I + 1) / 2
        Cells(J, 5).Interior.ColorIndex = I + 1
        Cells(J, 6) = I + 1
    Next I
End Sub
Nhấp chuột vào đây để mở rộng...

Sửa xong thấy phức tạp hơn code cũ:
1. Tại sao sửa For i = 2 thành For i = 1 rồi sau đó ColorIndex phải + 1?
2. j = j + 1 thì có vấn đề gì mà phải sửa? Và sửa xong nó phức tạp hơn?

Để y nguyên code cũ, bỏ if i Mod 2 = 0 đi là đã xong rồi:

Mã: 
    For I = 2 To 56 Step 2
        J = J + 1
        Cells(J, 5).Interior.ColorIndex = I
        Cells(J, 6) = I
    Next I

Bạn thấy đấy, For Next nhuần nhuyễn là thế, chỉ vì tư duy không đúng mà code bị phức tạp lên.
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
Mẹo toán: nếu bạn để ý sẽ thấy J luôn luôn = I/2. Suy ra biến J không cần.
Ngược lại, nếu đề không bắt buộc dùng step 2 thì ta có thể cho I chạy từ 1 đến 28 và dùng giá trị I*2
Nhấp chuột vào đây để mở rộng...

1. Không cần biến j:

Mã: 
 For i = 2 to 56 Step 2
    Cells(i / 2, 1).Interior.ColorIndex = i
    Cells(i / 2, 2) = i
Next

2. Không cần cả Step 2:

Mã: 
 For i = 1 to 28  
    Cells(i, 1).Interior.ColorIndex = i * 2
    Cells(i, 2) = i * 2
Next

Ghi chú: Đề ra Step 2 là có mục đích. Thí dụ ghi xuống sheet bắt đầu từ dòng 3 (áp dụng để ghi cái gì đó bất kỳ, chứ không phải ghi chỉ số màu theo quy luật tăng dần):

Mã: 
    [COLOR=#ff0000]j = 2[/COLOR]
    For i = 2 To 56 Step 2
        j = j + 1
        Cells(j, 5).Interior.ColorIndex = i
        Cells(j, 6) = i
    Next i
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
1. Không cần biến j:
2. Không cần cả Step 2:

Mã: 
 For i = 1 to 28  
    Cells(i, 1).Interior.ColorIndex = i * 2
    Cells(i, 2) = i * 2
Next

Ghi chú: Đề ra Step 2 là có mục đích. Thí dụ ghi xuống sheet bắt đầu từ dòng 3 (áp dụng để ghi cái gì đó bất kỳ, chứ không phải ghi chỉ số màu theo quy luật tăng dần):
Nhấp chuột vào đây để mở rộng...

Cám ơn ThầY Mỹ nhiều, lâu lâu xem lại để đầu óc hết mụ. E thấy code này là OK nhất nếu chỉ cần như thế. Các bạn thử xem nếu thực tập gán sang 1 range thì thế nào. Từ đó sẽ có tư duy để chuyển sang Array.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài tập mở rộng của For Next bài vừa rồi, Dùng biến j tăng 1 theo điều kiện để ghi dữ liệu thỏa điều kiện sang sheet khác.

Cho dữ liệu về các đơn hàng trong sheet Data:

Chọn số Đơn hàng trong validation ô C2 sheet Report.

- Xóa nội dung đơn hàng cũ
- Bằng vòng lặp For next: Chọn các dòng dữ liệu sheet Data có số đơn hàng giống ô C2 sheet Report, ghi vào sheet Report từ dòng số 5, bao gồm cả số thứ tự, Tên mặt hàng, số lượng, đơn giá
- Dùng property FormulaR1C1 gán công thức cột thành tiền = số lượng x đơn giá
- Gán chuỗi Total vào dòng kế tiếp ở cột B
- Dùng property FormulaR1C1 gán công thức tính tổng cột thành tiền tại dòng Total

Ghi chú:
Không dùng mảng cũng được, vì dữ liệu không nhiều.
Cố hạn chế vòng lặp thừa bằng cách xác định dòng cuối sheet Data bằng phương thức End
Có Kết quả mẫu cho đơn hàng số 11-03.
 

File đính kèm

  • Baitap01.xlsx
    14.4 KB · Đọc: 25
Upvote 0
Không cho Thu Nghi tham gia nhé, làm bộ quên phải học lại để tham gia sao?
 
Upvote 0
Bài này là khá phù hợp với thực tập nhưng phần kẻ khung sợ là hơi khó với các thành viện đang thực tập. Phải xóa khung và kẻ khung lại.
E đâu có tham gia, rảnh nên nên lên tham gia chém gió thôi. Mà chém với ý đồ tốt mà.
 
Upvote 0
ptm0412 đã viết:
Bài tập mở rộng của For Next bài vừa rồi, Dùng biến j tăng 1 theo điều kiện để ghi dữ liệu thỏa điều kiện sang sheet khác.
Cho dữ liệu về các đơn hàng trong sheet Data:
Chọn số Đơn hàng trong validation ô C2 sheet Report.
- Xóa nội dung đơn hàng cũ
- Bằng vòng lặp For next: Chọn các dòng dữ liệu sheet Data có số đơn hàng giống ô C2 sheet Report, ghi vào sheet Report từ dòng số 5, bao gồm cả số thứ tự, Tên mặt hàng, số lượng, đơn giá
- Dùng property FormulaR1C1 gán công thức cột thành tiền = số lượng x đơn giá
- Gán chuỗi Total vào dòng kế tiếp ở cột B
- Dùng property FormulaR1C1 gán công thức tính tổng cột thành tiền tại dòng Total
Ghi chú:
Không dùng mảng cũng được, vì dữ liệu không nhiều.
Cố hạn chế vòng lặp thừa bằng cách xác định dòng cuối sheet Data bằng phương thức End
Có Kết quả mẫu cho đơn hàng số 11-03.
Nhấp chuột vào đây để mở rộng...
Bài này em gửi đáp án vào email Thầy Mỹ nhé, Thầy check mail dùm.
Sở dĩ em gửi mail vì muốn học hỏi cách làm của các bạn khác.
 
Upvote 0
Phần border em bổ sung phần kẻ nét đứt như sau:
Mã: 
            Range("A5:E" & J + 5).Borders.LineStyle = 1
            With Range("A5:E" & J + 4).Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlHairline
            End With
 
Upvote 0
Oái! Bỗng nhiên mình bị biến thành người chấm điểm nè trời?
 
Upvote 0
ptm0412 đã viết:
Cho dữ liệu về các đơn hàng trong sheet Data:

Chọn số Đơn hàng trong validation ô C2 sheet Report.

- Xóa nội dung đơn hàng cũ
- Bằng vòng lặp For next: Chọn các dòng dữ liệu sheet Data có số đơn hàng giống ô C2 sheet Report, ghi vào sheet Report từ dòng số 5, bao gồm cả số thứ tự, Tên mặt hàng, số lượng, đơn giá
- Dùng property FormulaR1C1 gán công thức cột thành tiền = số lượng x đơn giá
- Gán chuỗi Total vào dòng kế tiếp ở cột B
- Dùng property FormulaR1C1 gán công thức tính tổng cột thành tiền tại dòng Total
Nhấp chuột vào đây để mở rộng...
Em cũng thử sức Code chạy trong Sheet2 (Code dùng Font màu trắng, các bạn bôi đen sẽ thấy - một cách Hide tạm thời; nhưng mà là "sáng kiến" nhé :))
Mã: 
Sub Button1_Click()
Dim startR As Long, endR As Long, lastR As Long
D[COLOR=#000000]im i As Long, j As Long
[/COLOR][COLOR=#fff0f5]
Rows("5:20").Delete     'Du lieu khong nhieu xoa tu dong 5 den dong 20
startR = 4              'Dong bat dau lay du lieu Sheet1 (cho biến vào bài này hơi thừa nhưng sẽ có ích với những bài khác)
endR = 64               'Dong ket thuc lay du lieu Sheet1 hay la Sheets("Data").Range("B1000").End(xlUp).Row

j = 5   'Dong bat dau ghi du lieu o Sheet2
For i = startR To endR
  With Sheets("Data")   'hoac la With Sheet1
    If .Cells(i, 2) = [C2] Then
      Cells(j, 2).Offset(, -1) = j - 4
      Cells(j, 2) = .Cells(i, 4)
      Cells(j, 2).Offset(, 1) = .Cells(i, 4).Offset(, 1)
      Cells(j, 2).Offset(, 2) = .Cells(i, 4).Offset(, 2)
      Cells(j, 2).Offset(, 3).FormulaR1C1 = "=RC[-2]*RC[-1]"
      j = j + 1
    End If
  End With
Next
    'Them cong thuc
lastR = Range("B50").End(xlUp).Row + 1 'Xac dinh dong duoi dong du lieu cuoi cung tim duoc tai Sheet2
Range("B" & lastR) = "Total"
Range("E" & lastR).FormulaR1C1 = "=SUM(R[-" & j - 5 & "]C:R[-1]C)"
Range("D5:E" & lastR).NumberFormat = "#,##0"
    'Ke khung vien
Range("A5:E" & lastR).Borders.LineStyle = 1
Range("A5:E" & lastR - 1).Borders(xlInsideHorizontal).Weight = xlHairline[/COLOR][COLOR=#000000]
[/COLOR]
End Sub
 

File đính kèm

  • Baitap01 - Phan Minh Phuong.xls
    55.5 KB · Đọc: 18
Lần chỉnh sửa cuối:
Upvote 0
phanminhphuong đã viết:
Em cũng thử sức Code chạy trong Sheet2 (Code dùng Font màu trắng, các bạn bôi đen sẽ thấy - một cách Hide tạm thời; nhưng mà là "sáng kiến" nhé :))
Nhấp chuột vào đây để mở rộng...
Mình góp ý, nếu theo bạn hay hơn thì hướng dẫn lại dùm nha:
- Không dùng Delete dòng, mà dùng Clear từ A5:E65535. Vì dùng Delete dòng ảnh hưởng đến giá trị ngoài bảng nếu có.
- Dư lastR, vì J đã là lastrow.
- Cells(j, 2).Offset(, 1) Hình như là dư Offset, có thể dùng Cells(j, 3).
- Border nét đứt, mình Record Marco nó ra 4 dòng, mà quên lựa chọn, mình học được bạn cái này.
 
Upvote 0
sinh sau đẻ muộn cũng xin làm bài này gởi thầy để học hỏi thêm các kỹ năng về property trong VBA
 

File đính kèm

  • Baitap01.7z
    27.6 KB · Đọc: 26
Upvote 0
Mọi người gửi lên thì em cũng gửi luôn, nhờ các Thầy chỉ bảo, có sửa lại một chút so với bài gửi trong mail Thầy Mỹ.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    Dim Rng As Range
    Dim I As Long, J As Long
    Set Rng = Sheet1.Range("B4:B" & Sheet1.Range("B65535").End(xlUp).Row)
        If Target.Address <> "$C$2" Then
        Exit Sub
        Else
            Range("A5:E65535").Clear
            For I = 1 To Rng.Rows.Count
                If Rng(I) = Target Then
                    J = J + 1
                    Cells(J + 4, 1) = J
                    Cells(J + 4, 2) = Rng(I).Offset(, 2)
                    Cells(J + 4, 3) = Rng(I).Offset(, 3)
                    Cells(J + 4, 4) = Format(Rng(I).Offset(, 4), "#,##0")
                    Cells(J + 4, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
                End If
            Next I
            Cells(J + 5, 2) = "Total"
            Cells(J + 5, 5).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
            Range("E5:E" & J + 5).NumberFormat = "#,##0"
            Range("A5:E" & J + 5).Borders.LineStyle = 1
            Range("A5:E" & J + 4).Borders(xlInsideHorizontal).Weight = xlHairline
        End If
Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • Baitap01.xls
    55 KB · Đọc: 15
Upvote 0
leonguyenz đã viết:
Mình góp ý, nếu theo bạn hay hơn thì hướng dẫn lại dùm nha:
- Không dùng Delete dòng, mà dùng Clear từ A5:E65535. Vì dùng Delete dòng ảnh hưởng đến giá trị ngoài bảng nếu có.
- Dư lastR, vì J đã là lastrow.
- Cells(j, 2).Offset(, 1) Hình như là dư Offset, có thể dùng Cells(j, 3).
- Border nét đứt, mình Record Marco nó ra 4 dòng, mà quên lựa chọn, mình học được bạn cái này.
Nhấp chuột vào đây để mở rộng...
- Bài này dữ liệu ít nên mình xóa dòng làm biếng thế mà (trong code đã nói rùi), xóa/ phá dữ liệu thì thiếu gì cách
- Công nhận dư lastR. Cứ viết là viết thui quên không check, Cho nên mình nghĩ khi viết code các bạn mới như mình cũng nên cho thêm phần kiểm tra biến vào Msgbox j hoặc Debug.Print j để quản lý biến tốt nhất có thể
- Dùng Offset() để tham chiếu đến 1 ô nguồn nhiều khi có lợi hơn (quan điểm cá nhân)
- Mình cũng Record Macro và thử mọi trường hợp để đạt kết quả và dễ nhìn, dễ sửa chữa sau này
 
Upvote 0
leonguyenz đã viết:
Mọi người gửi lên thì em cũng gửi luôn, nhờ các Thầy chỉ bảo, có sửa lại một chút so với bài gửi trong mail Thầy Mỹ.
Nhấp chuột vào đây để mở rộng...

Em cũng tham gia chút, Thầy Mỹ tiện thể chấm điểm luôn dùm em.

PHP: 
Sub TrichLoc()
Dim i&, dong&, eR&
Dim DonHang As String
Dim myRng As Range
With Sheets("Data")
  eR = .Cells(65000, 2).End(xlUp).Row
  Set myRng = .Range("A4:F" & eR)
End With
dong = 4
With Sheets("Report")
  .Range("A5:E100").Borders.LineStyle = 0
  DonHang = CStr(.Cells(2, 3))
  For i = 1 To myRng.Rows.Count
    If CStr(myRng(i, 2)) = DonHang Then
      dong = dong + 1
      .Cells(dong, 1) = dong - 4
      .Cells(dong, 2) = myRng(i, 4)
      .Cells(dong, 3) = myRng(i, 5)
      .Cells(dong, 4) = myRng(i, 6)
      .Cells(dong, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
  Next i
  .Cells(dong + 1, 2) = "Total"
  .Cells(dong + 1, 5).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
  With .Range("A5:E" & dong + 1)
    With .Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlInsideHorizontal)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
    End With
End With
Set myRng = Nothing
End Sub
 
Upvote 0
Các cụm (block) range trong bài này đều là cụm đặc, không có chỗ đứt đoạn. Nếu không dùng For Each thì không cần phải dùng OFFSET. Chỉ cần đặt Ranges vào ô đầu tiên của nơi đi và ô đầu tiên của ô đến là cái Cells(n,m) property nó cho truy cập hết.

Ranges:
Set rgFr = Sheets("Dữ liệu").Range("Ô đầu tiên của nhóm dữ liệu")
Set rgTo = Sheets("Đơn hàng").Range("Ô đầu tiên cần ghi chi tiết đơn hàng")

Vòng lặp:
J bắt đầu là 0
FOR i = 1 to dongCuoi - dongDau + 1
nếu so rgFr(i,1) = Đúng điều kiện
j = j + 1
rgTo.Cells(j, 1) = j
rgTo.Cells(j, 2) = rgFr.Cells(i, ...)
...
NEXT i
rgTo.Cells(j+1, 5) = công thức tổng

làm xong thì set mấy cái ranges về nothing
 
Upvote 0
tungnguyen_kt đã viết:
Em cũng tham gia chút, Thầy Mỹ tiện thể chấm điểm luôn dùm em.

Mã: 
Sub TrichLoc()
Dim i&, dong&, eR&
Dim DonHang As String
Dim myRng As Range
With Sheets("Data")
  eR = .Cells(65000, 2).End(xlUp).Row
  Set myRng = .Range("A4:F" & eR)
End With
dong = 4
With Sheets("Report")
  .Range("A5:E100").Borders.LineStyle = 0
  DonHang = CStr(.Cells(2, 3))
  For i = 1 To myRng.Rows.Count
    If CStr(myRng(i, 2)) = DonHang Then
      dong = dong + 1
      .Cells(dong, 1) = dong - 4
      .Cells(dong, 2) = myRng(i, 4)
      .Cells(dong, 3) = myRng(i, 5)
      .Cells(dong, 4) = myRng(i, 6)
      .Cells(dong, 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
    End If
  Next i
  .Cells(dong + 1, 2) = "Total"
  .Cells(dong + 1, 5).FormulaR1C1 = "=SUM(R5C:R[-1]C)"
  [COLOR=#ff0000]With .Range("A5:E" & dong + 1)
    With .Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Borders(xlInsideHorizontal)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
    End With[/COLOR]
End With
Set myRng = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Đoạn mảu đỏ ấy thừa cả thúng luôn
 
Upvote 0
tungnguyen_kt đã viết:
Thà dziết làm còn hơn bỏ sót, hehe... em nói vui thôi, phiền mấy anh chị chỉ dẫn.
Nhấp chuột vào đây để mở rộng...
Chẳng phải bài của phanminhphuong & leonguyenz đã có đoạn code kẻ khung rồi sao
Range("A5:E" & lastR).Borders.LineStyle = 1 => Kẻ đường viền toàn bộ vùng dữ liệu từ ô A5:E(dòng cuối cùng)
Range("A5:E" & lastR - 1).Borders(xlInsideHorizontal).Weight = xlHairline => Kẻ nét đứt ở giữa (chừa dòng cuối cùng ra)

Về code đánh số thứ tự thực sự thấy đưa vào vòng lặp như bài này cũng được vì dữ liệu ít nhưng mà mình thấy chiêu này của bác PTM0412 còn hay hơn
Range("A5:A" & lastR - 1) = Evaluate("=Row(R:R)")
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
2
Đọc
44
anhgp1
A
T
  • Question
Ghép 2 cột dữ liệu
Trả lời
2
Đọc
13
HieuCD
H
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
11
Đọc
159
VetMini
V
N
Xin code tính tổng số cấu đúng viết trong "Visual Basic" trong PPT
Trả lời
1
Đọc
4K
hahuy_hien2000
H
8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
3
Đọc
88
HieuCD
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom