Đố vui về VBA!

Liên hệ QC

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,905
Nhằm cũng cố kiến thức về VBA cho các bạn mới bắt đầu và cả những bạn đang ứng dụng mà chưa hiểu nhiều về nó, tôi mở topic này với mong mõi qua những câu hỏi vui, các bạn sẽ nhận định lại sự hiểu biết cũa mình... (Kễ cã chính tôi cũng đang tập tành nên có rất nhiều cái chưa biết)
Mong rằng topic sẽ mang đến cho các bạn những khám phá thú vị với những cái tưỡng chừng như đã biết
Mong nhận dc bài viết về câu đố cũa các cao thủ! Còn các bạn mới thì đừng ngại khi đưa ra ý kiến cũa mình.. Có sai có sữa sẽ hoàn thiện!
Tôi xin mỡ màn trước bằng 1 câu hỏi đơn giãn
ANH TUẤN

CÂU HỎI 1: Tại sao biến K ko hoạt động?
Tôi muốn khi nhấn vào 1 button thì cell A1 sẽ tăng lên 1 đơn vị... Tôi đã làm như sau:
-Tạo 1 Command Button (nút nhấn thuộc thanh Control Toolbox), click phải chuột lên nút nhấn, chọn View code, rồi gõ vào đoạn code sau:
PHP:
Private Sub CommandButton1_Click()
   K = K + 1
   Range("A1").Value = K
End Sub
Ban đầu K chưa có gì, xem như =0, nhấn nút lần thứ nhất thì K dc tăng thêm 1, vậy K hiện tại sẽ bằng 1, và gán K vào cell A1 thì đương nhiên A1 sẽ =1... Nhấn nút lần 2, K lại dc tăng thêm 1 nên hiện tại K sẽ =2 và cell A1 cũng sẽ =2... vân vân.. từ đó diễn tiến tiếp...
Hi.. hi.. Điều này nghe qua có vẽ rất hợp lý, ấy thế mà khi nhấn nút nó chỉ hoạt động dc duy nhất 1 lần (A1 = 1) rồi thôi ko nhút nhít nữa...
Các bạn có thể giãi thích tại sao lại như thế ko? Tại sao những lần nhấn nút sau đó K lại ko tăng thêm tí nào (vì thực tế A1 vẫn cứ = 1 hoài) ?
ANH TUẤN
 
Có tình huống thế này:
- Tôi vẽ 1 Buttons nằm gọn trong cell A1 (Buttons này thuộc thanh Forms)
- Chọn cell A1 và bấm Ctrl + C
- Quét chọn A2:A10 và bấm Ctrl + V
Với 3 bước thao tác tôi đã tạo được 10 Buttons
Và cho dù có tạo ra 100 Buttons hay nhiều hơn nữa, tôi cũng chỉ cần 3 thao tác (như trên)
Vậy xin hỏi các bạn: Chúng ta viết code thực hiện quá trình trên như thế nào?
(Thử record macro xem, nhưng e rằng khi xem xong code record sẽ làm các bạn thất vọng)
-------------------------------------------------------------------------------
Nếu viết được code vẽ 10 Buttons trên 1 sheet thì tôi nghĩ việc này cũng có thể thực hiện trên nhiều sheet trong cùng 1 lúc đấy nhỉ? Hi... Hi...
Vẽ nhiều button trên 1 sheet thì không vấn đề gì, nhưng không rõ yêu cầu còn có ràng buộc gì đặc biệt không???
 
Upvote 0
Kẻ khung (Border) cho 1 vùng

Trước tiên các bạn hãy xem qua topic này: Code về Borders
Ở đây người ta đã giải quyết vấn đề kẻ khung thông qua vòng lập!
Đố các bạn biết: Còn cách nào khác có thể kẻ khung cho 1 vùng mà không cần vòng lập không?
(Không tính đến SendKeys)
-----------------------------------------------------------------------------------------------------------------------
Hỏi cả 1 đóng nhưng chẳng thấy ai tham gia dù chỉ là thắc mắc... Hic...
Xin thưa với các bạn rằng Excel vẫn còn rất nhiều.. rất nhiều thứ ta chưa biết lắm.. và nó có khà năng làm được nhiều hơn ta tưởng đấy
(Ngày nào tôi cũng nghiên cứu và luôn phát hiện ra nhiều điều mới lạ)
 
Upvote 0
"Cùng lúc" theo tôi hiều là không dùng vòng lặp, không rõ có đúng không???
Như tôi đã nói ở bài #280, tôi làm bằng tay chỉ 3 thao tác là có thể tạo ra bao nhiêu Buttons tùy ý... Tương tự như thế cho bài tạo Border, chỉ 1 thao tác bằng tay là tôi có thể kẻ khung cho toàn bộ các cell của vùng chọn... Vậy lý nào viết code lại phải cần đến vòng lập?
Bạn biểu diển xem! Tôi cũng rất muốn học hỏi!
 
Upvote 0
Như tôi đã nói ở bài #280, tôi làm bằng tay chỉ 3 thao tác là có thể tạo ra bao nhiêu Buttons tùy ý... Tương tự như thế cho bài tạo Border, chỉ 1 thao tác bằng tay là tôi có thể kẻ khung cho toàn bộ các cell của vùng chọn... Vậy lý nào viết code lại phải cần đến vòng lập?
Bạn biểu diển xem! Tôi cũng rất muốn học hỏi!
Code sau sẽ tạo danh sách buttons, nhưng mấu chốt ở đây là phải có lựa chọn Cut, copy, and sort objects with cells trong tuỳ chỉnh của excel, nếu không thì thao tác thực hiện bằng tay cũng không được.
Mã:
Sub CreateButtons()
    ActiveSheet.Shapes.AddFormControl xlButtonControl, [A1].Left, [A1].Top, [A1].Width, [A1].Height
    Range("A1").Copy [A2:A10]
End Sub
 
Upvote 0
Code sau sẽ tạo danh sách buttons, nhưng mấu chốt ở đây là phải có lựa chọn Cut, copy, and sort objects with cells trong tuỳ chỉnh của excel, nếu không thì thao tác thực hiện bằng tay cũng không được.
Mã:
Sub CreateButtons()
ActiveSheet.Shapes.AddFormControl xlButtonControl, [A1].Left, [A1].Top, [A1].Width, [A1].Height
Range("A1").Copy [A2:A10]
End Sub
Chính xác như tôi đã làm:
PHP:
Sub Draw10Buttons()
  With Range("A1")
    .Parent.Buttons.Add .Left, .Top, .Width, .Height
    .AutoFill Range("A1:A10")
  End With
End Sub
Vậy mời bạn tiếp bài Border nhé
Tôi còn hơn 1 tá câu hỏi nữa nhưng cũng hơi buồn vì chỉ thấy mổi mình bạn tham gia... chẳng han:
- Có thể lấy toàn bộ tên file trong 1 thư mục nào đó (không tính thư mục con) mà không cần đến vòng lập hay không?
- Có thể lấy toàn bộ tên của các Workbooks đang mở mà không cần đến vòng lập hay không?
- Từ 1 file text (txt) chứa nội dung code VBA, có thể import code này vào cửa sổ VBA của workbook hiện hành hay không?
vân vân..
 
Lần chỉnh sửa cuối:
Upvote 0
Chính xác như tôi đã làm:
PHP:
Sub Draw10Buttons()
  With Range("A1")
    .Parent.Buttons.Add .Left, .Top, .Width, .Height
    .AutoFill Range("A1:A10")
  End With
End Sub
Vậy mời bạn tiếp bài Border nhé
Tôi còn hơn 1 tá câu hỏi nữa nhưng cũng hơi buồn vì chỉ thấy mổi mình bạn tham gia... chẳng han:
- Có thể lấy toàn bộ tên file trong 1 thư mục nào đó (không tính thư mục con) mà không cần đến vòng lập hay không?
- Có thể lấy toàn bộ tên của các Workbooks đang mở mà không cần đến vòng lập hay không?
- Từ 1 file text (txt) chứa nội dung code VBA, có thể import code này vào cửa sổ VBA của workbook hiện hành hay không?
vân vân..
Đoạn code sau sẽ vẽ Border cho vùng A1:B6, tuy nhiên code này còn rất nhiều hạn chế, dù sao nó cũng không cần dùng vòng lặp :), không rõ có giống ý tưởng của tác giả hay không.
Mã:
Sub DrawBoders()
    Dim arr
    ThisWorkbook.Names.Add "rng", "=TRANSPOSE(ADDRESS(INT((ROW(Sheet1!$1:$20)-1)/2+1),MOD((ROW(Sheet1!$1:$20)-1),2)+1))"
    arr = Evaluate("TRANSPOSE(""INDEX(rng,1,""&ROW(A1:A12)&"")"")")
    Range(Evaluate(Join(arr, "&"",""&"))).BorderAround xlSolid, xlThin, xlColorIndexAutomatic, vbBlack
    ThisWorkbook.Names("rng").Delete
End Sub
Code này sẽ đơn giản hơn chút, vẽ borders cho vùng được chọn, tư tưởng vẫn vậy, nhưng vẫn còn hạn chế
Mã:
Sub DrawBoders()
    Dim rng As Range
    Set rng = Selection
    
    Dim iRowRop As Integer
    Dim iRows As Integer
    Dim iColLeft As Integer
    Dim iCols As Integer
    iRowRop = rng.Row
    iRows = rng.Rows.Count
    iColLeft = rng.Column
    iCols = rng.Columns.Count
    
    Range(Join(Evaluate("TRANSPOSE(ADDRESS(INT((ROW(1:" & iRows * iCols & ")-1)/" & iCols & "+" & iRowRop & "),MOD((ROW(1:" & iRows * iCols & ")-1)," & iCols & ")+" & iColLeft & "))"), ",")).BorderAround xlSolid, xlThin, xlColorIndexAutomatic, vbBlack
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mấy hôm tìm cái BorderAll mà không ra, té ra là BorderAround. Hướng là vầy:
- BorderAround 1 cell (cell đầu tiên trong vùng chọn)
- Copy paste special Formats cho các cell còn lại.
 
Upvote 0
Mấy hôm tìm cái BorderAll mà không ra, té ra là BorderAround. Hướng là vầy:
- BorderAround 1 cell (cell đầu tiên trong vùng chọn)
- Copy paste special Formats cho các cell còn lại.
Cách này tôi có nghĩ qua, nhưng không ổn, paste Format là nó paste toàn bộ định dạng chứ đâu có paste riêng border đâu, người ta chỉ muốn kẻ khung mà đi thay đổi cả các định dạng khác(chữ đậm, nghiêng, màu nền, ...) thì sao chấp nhận đc.
 
Upvote 0
Thật ra có 1 cách rất đơn giản nếu chúng ta biết rằng macro 4 có hàm này:
PHP:
BORDER(outline, left, right, top, bottom, shade, outline_color, left_color, right_color, top_color, bottom_color)
Vậy ta viết như sau:
PHP:
Sub BorderAll()
  Dim K As Long
  K = 1
  ExecuteExcel4Macro ("BORDER(" & K & "," & K & "," & K & "," & K & "," & K & ")")
End Sub
- Chọn vùng rồi chạy code sẽ ra được kết quả như ý
- Thay K từ 0 đến 13 để xem thay đổi
- Còn các tham số phía sau cho phép tô màu khung nữa đấy
-------------------------------------------------------------------
Hãy tham khảo các hàm macro 4 khác để giải các câu hỏi còn lại (rất dể dàng)
- Hàm FILES trả về 1 Array với các phần tử là tên của tất cả các file trong 1 thư mục đã chỉ định
- Hàm DOCUMENTS trả về 1 Array với các phần tử là tên của tất cả các Workbook đang mở
Vậy đâu cần phải For... Next
Riêng về phần import 1 file text chưa code VBA vào của sổ VBA của WB hiện hành, xin mời các bạn tự nghiên cứu. Còn rất nhiều món độc chiêu khác nữa đấy!
 

File đính kèm

  • Border_NoLoop.xls
    18 KB · Đọc: 45
Lần chỉnh sửa cuối:
Upvote 0
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã:
Workbooks("Book1.xls").Activate

Mã 2:
Mã:
Workbooks("Book1").Activate

Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1. Xin chú ý, workbook này đã lưu.

(Tip: Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Upvote 0
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã:
Workbooks("Book1.xls").Activate

Mã 2:
Mã:
Workbooks("Book1").Activate

Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1

(Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
Cho em hỏi thêm là Book1 đó lưu file chưa?
Em nghĩ mã 2 đúng vì nó chạy tốt hơn. File lưu và chưa lưu ngay cả Office 2007 trở lên, còn code Mã 1 chỉ chạy cho những file đã lưu rồi và phiên bản từ Office 2003 trở xuống.
Không biết phải vậy không
 
Upvote 0
Hi domfootware,

Câu trả lời chưa đúng. Workbook book1 đã được lưu và đang mở cùng với một số workbook khác.

Lê Văn Duyệt
 
Upvote 0
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã:
Workbooks("Book1.xls").Activate
Mã 2:
Mã:
Workbooks("Book1").Activate
Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1. Xin chú ý, workbook này đã lưu.

(Tip: Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
Tôi chưa thử trên Excel 2007 nên không biết thế nào, còn riêng Excel 2003 thì đoạn code này: Workbooks("Book1").Activate chưa bao giờ chạy thành công nếu Book1 đã được lưu
Lúc nào xài thì tôi luôn dùng Workbooks("Book1.xls").Activate
Thí nghiệm: Đứng tại book1 và chạy đoạn code này:
PHP:
Sub Test2()
 MsgBox ActiveWorkbook.Name
End Sub
Nó cho kết quả là book1.xls đấy nha (không phải là book1)
Nếu book1 chưa lưu thì thì đoạn code 1 chạy đúng và ngược lại
(có vẽ như khi ta chưa lưu file thì Excel chưa thể xác định đuôi file ấy là gì nên chỉ cần gọi tên là được)
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi chưa thử trên Excel 2007 nên không biết thế nào, còn riêng Excel 2003 thì đoạn code này: Workbooks("Book1").Activate chưa bao giờ chạy thành công nếu Book1 đã được lưu

Anh hãy thử chỉnh chức năng này của Window Explorer:

folderoption.jpg


Rồi anh thử hai đoạn mã ở trên. Chắc chắn rẳng sẽ có một đoạn mã báo lỗi như sau:

runtimeerror9.jpg


Tùy theo từng trường hợp thiết lập Hide extensions for know file type (hi hi hi, như vậy mới rơi vào bẫy của em chứ)

Anh thử xong rồi ta lại tiếp tục bàn luận.

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Upvote 0
Tổng hợp dữ liệu từ các file trong 1 thư mục (Consolidate)

Chắc các bạn đều biết công cụ Consolidate, nó có khả năng tổng hợp dữ liệu từ nhiều sheet, thậm chí từ nhiều file
Việc viết code có thể dựa trên cơ sơ Record macro rồi chỉnh lại
Vấn đề ở đây là tôi có 4 file nằm trong 1 thư mục, tôi muốn dùng Consolidate để tổng hợp nó ra 1 file khác mà không cần đến 1 vòng lập nào
Các bạn hãy thử xem
Có file đính kèm, ra kết quả giống như trong file ConsolMutiFiles.xls là xem như thành công! (các file con nằm trong thư mục Source)
Lưu ý:
- Ta chỉ biết các file con nằm trong 1 thư mục chỉ định trước chứ không biết có tổng cộng bao nhiêu file con và tên file con là gì đâu nha
- Biết trước: các file con nằm trong thư mục Source (là thư mục con của thư mục chứa file ConsolMutiFiles.xls)
- Biết trước: Dữ liệu cần tổng hợp trong các file con nằm ở "Sheet1", vùng "A2:B30"
 

File đính kèm

  • ConsolMutiFiles.rar
    20.6 KB · Đọc: 39
Lần chỉnh sửa cuối:
Upvote 0
Thật ra có 1 cách rất đơn giản nếu chúng ta biết rằng macro 4 có hàm này:
PHP:
BORDER(outline, left, right, top, bottom, shade, outline_color, left_color, right_color, top_color, bottom_color)
Vậy ta viết như sau:
PHP:
Sub BorderAll()
  Dim K As Long
  K = 1
  ExecuteExcel4Macro ("BORDER(" & K & "," & K & "," & K & "," & K & "," & K & ")")
End Sub
Cám ơn ndu nhiều, vậy có UDF noBorder không. Làm giúp 1 cái.
 
Upvote 0
Web KT
Back
Top Bottom