Đố vui về VBA!

anhtuan1066 · 30/12/07

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

Hai Lúa Miền Tây · 17/11/09

anhtuan1066 đã viết:
Bất cứ kiểu gì các bạn cảm thấy thích hợp, miển không dùng vòng lập và code... HAY
Hi... hi...
Ra tay thử đi bạn ơi! (cho vui nhà vui cửa)

Nghĩ mãi không ra code hay thầy à.
Không dùng dòng lặp thì còn nước là qui định sheet trong mãn mà select thôi thầy à. +-+-+-+

anhtuan1066 · 17/11/09

domfootwear đã viết:
Nghĩ mãi không ra code hay thầy à.
Không dùng dòng lặp thì còn nước là qui định sheet trong mãn mà select thôi thầy à.

Gợi ý:
Giả sử ta dời sheet Dulieu đến vị trí đầu tiên (nằm bên trái), sau đo record macro quá trình chọn từ sheet2 đến sheet cuối, ta sẽ được code đại khái như sau:

PHP:

Sub Macro1()
  Sheets(Array("Sheet2", "Sheet3", "Sheet4")).Select
  Sheets("Sheet3").Activate
End Sub

Code này có thể sửa lại:

PHP:

Sub Macro1()
  Sheets(Array(2, 3, 4)).Select
End Sub

Gần ra rồi đấy!
Việc của bạn bây giờ là "định" 1 Array có giá trị từ 2 đến Sheets.Count.. sau đó ráp vào

PHP:

Sub SelectMultiSheets()
  Dim Temp
  Temp = ... gì gì đó
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Đương nhiên Temp là 1 Array, có giá trị = {2,3,4,..... ,Sheets.Count}
Đại khái thế... Cố xem!
Hi... hi...

ngocmaipretty · 17/11/09

Đương nhiên Temp là 1 Array, có giá trị = {2,3,4,..... ,Sheets.Count}

Hì, chắc lại xài create object gì đó chứ gì, ngocmai không biết VBA nhưng đoán vậy, vì là độc chiêu của anhtuan&ndu mừ.

anhtuan1066 · 17/11/09

ngocmaipretty đã viết:
Hì, chắc lại xài create object gì đó chứ gì, ngocmai không biết VBA nhưng đoán vậy, vì là độc chiêu của anhtuan&ndu mừ.

Ah... không phức tạp thế đâu... Một Array bình thường như ta vẫn thường làm khi tạo name động ấy (gần gần giống với công thức ROW(INDIRECT("1:"&...... )
Không hề khó đâu!

sealand · 17/11/09

Để có thể giải quyết gọn hơn mình muốn tham khảo các bạn 1 chút:
-Để chọn sheet1 ta dùng lệnh Sheet1.Select
-Khi ta bỏ chọn 1 sheet ta dùng lệnh gì?

Nếu giải đáp được thì vấn đề đơn giản hơn nhiều: Ta chọn toàn bộ sheet bằng lệnh ThisWorkbook.Sheets.Select.
Sau đó ta bỏ chọn sheet theo yêu cầu là xong.

anhtuan1066 · 17/11/09

sealand đã viết:
Để có thể giải quyết gọn hơn mình muốn tham khảo các bạn 1 chút:
-Để chọn sheet1 ta dùng lệnh Sheet1.Select
-Khi ta bỏ chọn 1 sheet ta dùng lệnh gì?

Nếu giải đáp được thì vấn đề đơn giản hơn nhiều: Ta chọn toàn bộ sheet bằng lệnh ThisWorkbook.Sheets.Select.
Sau đó ta bỏ chọn sheet theo yêu cầu là xong.

Không được anh à! cách này không khả thi
Vì khi toàn bộ sheet đã được Select (tức chúng đã nằm chung 1 Group) mọi tác động cố gắng tách 1 sheet ra khỏi Group cũng đều làm cho Group ấy bị "rã đám" ngay!
Em gợi ý theo cách em đã nói ở trên:
- Tạo 1 biến ="ROW(2:" & Sheets.Count & ")"
- Xử lý biến này thêm vài "chiêu" nữa cho nó biến thành Array là xong!
Thực chất hoàn toàn khả thì, vì khi dùng name động ta vẫn thường làm theo kiểu này (ROW(INDIRECT("1:"&..... )

sealand · 17/11/09

Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon()
    Sheets("Data").Move Before:=Sheets(1)
    Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _
    Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select
    End Sub

Hai Lúa Miền Tây · 17/11/09

sealand đã viết:
Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon() Sheets("Data").Move Before:=Sheets(1) Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _ Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select End Sub

Cái này cũng giống như sau:

Mã:

Sub SelectMultiSheets()
  Dim Temp
  Temp = Array(2, 3, 4, 5, 6, 7, 8, 9, 10)
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Em đã thử rồi, như em đã nói ở trên, cách này là cách thủ công, chọn từng sheet anh à, cái khó là chọn tất cả các sheet bằng 1 câu nào đó trừ sheet "Dulieu" ra. +-+-+-+

anhtuan1066 · 17/11/09

sealand đã viết:
Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon() Sheets("Data").Move Before:=Sheets(1) Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _ Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select End Sub

-----------------------

domfootwear đã viết:
Cái này cũng giống như sau:

Mã:

Sub SelectMultiSheets() Dim Temp Temp = Array(2, 3, 4, 5, 6, 7, 8, 9, 10) Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Temp).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Em đã thử rồi, như em đã nói ở trên, cách này là cách thủ công, chọn từng sheet anh à, cái khó là chọn tất cả các sheet bằng 1 câu nào đó trừ sheet "Dulieu" ra.

Vâng! Cũng gần như thế
Vấn đề là ta đâu có biết trước Workbook gồm bao nhiêu sheet? (đề bài cho 10 sheet chỉ là giả lập thôi)
------------
Thôi, làm luôn

PHP:

Sub SelectMultiSheets()
  Dim Temp
  Temp = Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Hoặc ngắn gọn, khỏi cần biến luôn

PHP:

Sub SelectMultiSheets()
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

sealand · 17/11/09

AnhTuan dùng Evaluate quá hay. Đây là cách định trị không cần dùng vòng lặp để set. AnhTuan đã đề cập về hàm này của VBA (Không phải Macro4) trong 1 bài gần đây (Hình như bài sử dụng hàm Ad-In trong VBA thì phải), nhưng thực lòng mình không nghĩ ra.
Xin lỗi, mình cố tình "chọc" để AnhTuan giải đáp nhé, chứ câu lệnh của mình khỏi cần Move chi hết mà trực tiếp chỉ đầu từng "thằng" rôi.

anhtuan1066 · 18/11/09

sealand đã viết:
Xin lỗi, mình cố tình "chọc" để AnhTuan giải đáp nhé, chứ câu lệnh của mình khỏi cần Move chi hết mà trực tiếp chỉ đầu từng "thằng" rôi.

Vâng! Đây cũng chính là yêu cầu của câu đố tiếp theo!
Nội dung:
- Với một Workbook chứa nhiều sheet, hãy dùng code để Select toàn bộ các sheet (ngoại trừ sheet hiện hành) mà không dùng đến vòng lập
Yêu cầu phụ:
- Không được di chuyển bất cứ sheet nào ra khỏi vị trí hiện tại của nó
----------------------
Câu hỏi này gần giống với bài #157 nhưng ở cấp độ khó hơn rất nhiều... Mời các cao thủ thử sức (giải thuật đã có, tin rằng các bạn sẽ làm được)

rollover79 · 18/11/09

anhtuan1066 đã viết:
-----------------------

Vâng! Cũng gần như thế
Vấn đề là ta đâu có biết trước Workbook gồm bao nhiêu sheet? (đề bài cho 10 sheet chỉ là giả lập thôi)
------------
Thôi, làm luôn

PHP:

Sub SelectMultiSheets() Dim Temp Temp = Evaluate("Transpose(ROW(2:" & Sheets.Count & "))") Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Temp).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Hoặc ngắn gọn, khỏi cần biến luôn

PHP:

Sub SelectMultiSheets() Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Code này cần phải có thêm 1 điều kiện là tất cả các sheet phải đang ở trạng thái hiển thị, nếu có 1 sheet nào đang ở trạng thái ẩn là có vấn đề ngay. Nếu chỉ khử "câu lệnh vòng lặp" thì có thể dùng đến thủ thuật để gọi lại hàm tương tự như đệ quy để khử, phương pháp này thực chất vẫn là lặp nhưng không sử dụng câu lệnh vòng lặp, và có thể xử lý tất cả các trường hợp như sheet ẩn, không di chuyển sheet ...

anhtuan1066 · 18/11/09

rollover79 đã viết:
Code này cần phải có thêm 1 điều kiện là tất cả các sheet phải đang ở trạng thái hiển thị, nếu có 1 sheet nào đang ở trạng thái ẩn là có vấn đề ngay. Nếu chỉ khử "câu lệnh vòng lặp" thì có thể dùng đến thủ thuật để gọi lại hàm tương tự như đệ quy để khử, phương pháp này thực chất vẫn là lặp nhưng không sử dụng câu lệnh vòng lặp, và có thể xử lý tất cả các trường hợp như sheet ẩn, không di chuyển sheet ...

Vâng! Cảm ơn những góp ý của bạn!
Ở đây mình chỉ "tập dợt" về thuật toán, chia sẽ những kiến thức tình cờ phát hiện ra (mà ta cho là hay và lạ)
Vậy ta thống nhất với nhau thế này nhé: Trong Workbook không có sheet ẩn nào
ĐỆ QUY rất hay (mình vẫn đang học) nhưng ở đây mình cũng xin loại trừ phương pháp này, vì thực chất nó vẫn là LẬP
Cứ dựa trên cơ sơ này mà làm, nếu có điều kiện ta sẽ nâng cấp độ khó lên (như bạn vừa nói)
Mến
ANH TUẤN

rollover79 · 18/11/09

anhtuan1066 đã viết:
Vâng! Cảm ơn những góp ý của bạn!
Ở đây mình chỉ "tập dợt" về thuật toán, chia sẽ những kiến thức tình cờ phát hiện ra (mà ta cho là hay và lạ)
Vậy ta thống nhất với nhau thế này nhé: Trong Workbook không có sheet ẩn nào
ĐỆ QUY rất hay (mình vẫn đang học) nhưng ở đây mình cũng xin loại trừ phương pháp này, vì thực chất nó vẫn là LẬP
Cứ dựa trên cơ sơ này mà làm, nếu có điều kiện ta sẽ nâng cấp độ khó lên (như bạn vừa nói)
Mến
ANH TUẤN

Vậy nhân tiện xin hỏi bác luôn là điều kiện không di chuyển bất cứ sheet nào ra khỏi vị trí của nó là trong toàn bộ quá trình chạy các sheet vẫn phải yên vị ở đúng vị trí đó hay có thể di chuyển nhưng cuối cùng phải đưa nó về vị trí như ban đầu?

anhtuan1066 · 18/11/09

rollover79 đã viết:
Vậy nhân tiện xin hỏi bác luôn là điều kiện không di chuyển bất cứ sheet nào ra khỏi vị trí của nó là trong toàn bộ quá trình chạy các sheet vẫn phải yên vị ở đúng vị trí đó hay có thể di chuyển nhưng cuối cùng phải đưa nó về vị trí như ban đầu?

Bạn muốn làm thế nào tùy thích, miễn sao kết thúc quá trình thì mọi thứ vẫn được đặt đúng ví trí (như ban đầu)
Đương nhiên sẽ ưu tiên cho giải pháp KHÔNG DỊCH CHUYỂN SHEET trong quá trình chạy code!
Cảm ơn bạn đã quan tâm đến topic này... (Cao thủ nhúng tay vào chắc có nhiều điều để học hỏi đây)

rollover79 · 18/11/09

anhtuan1066 đã viết:
Bạn muốn làm thế nào tùy thích, miễn sao kết thúc quá trình thì mọi thứ vẫn được đặt đúng ví trí (như ban đầu)
Đương nhiên sẽ ưu tiên cho giải pháp KHÔNG DỊCH CHUYỂN SHEET trong quá trình chạy code!
Cảm ơn bạn đã quan tâm đến topic này... (Cao thủ nhúng tay vào chắc có nhiều điều để học hỏi đây)

Bác nói quá rồi, chẳng qua thấy bác sưu tầm được nhiều bài toán hay hay nên cũng muốn thử chút. Tôi thử 2 phương pháp, chủ yếu vẫn dựa vào ý tưởng trên.
Phương án có di chuyển sheet trong quá trình chạy(giữ nguyên đoạn giữa của bác):

Mã:

Sub SelectMultiSheets()
    Dim i As Integer
    i = Sheets("Dulieu").Index
    '--------------------------------------------------------------
    Sheets("Dulieu").Move Before:=Sheets(1)
    Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select
    MsgBox ActiveWindow.SelectedSheets.Count
    '--------------------------------------------------------------
    Dim sh
    Set sh = ActiveWindow.SelectedSheets
    Sheets("Dulieu").Move after:=Sheets(i)
    sh.Select
End Sub

Phương án không di chuyển sheet trong quá trình chạy:

Mã:

Sub SelectMultiSheets()
    Sheets(Evaluate("Transpose(ROW(1:" & Sheets.Count - 1 & ")+IF(ROW(1:" & Sheets.Count - 1 & ")>=" & Sheets("Dulieu").Index & ",1,0))")).Select
    MsgBox ActiveWindow.SelectedSheets.Count
End Sub

-----
Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

anhtuan1066 · 18/11/09

rollover79 đã viết:
Bác nói quá rồi, chẳng qua thấy bác sưu tầm được nhiều bài toán hay hay nên cũng muốn thử chút. Tôi thử 2 phương pháp, chủ yếu vẫn dựa vào ý tưởng trên.
Phương án có di chuyển sheet trong quá trình chạy(giữ nguyên đoạn giữa của bác):

Mã:

Sub SelectMultiSheets() Dim i As Integer i = Sheets("Dulieu").Index '-------------------------------------------------------------- Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select MsgBox ActiveWindow.SelectedSheets.Count '-------------------------------------------------------------- Dim sh Set sh = ActiveWindow.SelectedSheets Sheets("Dulieu").Move after:=Sheets(i) sh.Select End Sub

Phương án không di chuyển sheet trong quá trình chạy:

Mã:

Sub SelectMultiSheets() Sheets(Evaluate("Transpose(ROW(1:" & Sheets.Count - 1 & ")+IF(ROW(1:" & Sheets.Count - 1 & ")>=" & Sheets("Dulieu").Index & ",1,0))")).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

-----
Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

Vẫn có chổ đáng đề học đấy bạn chứ... Chiêu hay trong này theo tôi là
Set sh = ActiveWindow.SelectedSheets
Công nhân là rất khéo léo
Đoạn code thứ 2 cũng rất ngắn gọn và tinh tế
Mình xin đưa lên giải pháp "củ chuổi" này (nói rằng củ chuối là vì phải thông qua việc xử lý chuổi)

PHP:

Sub SelectMultiSheets()
  Dim Temp As String, i As Long
  i = ActiveSheet.Index
  Temp = Join(Evaluate("Transpose(Row(1:" & Sheets.Count & "))"), ",")
  Temp = Replace(Replace(Temp, "," & i, ""), i & ",", "")
  Sheets(Evaluate("{" & Temp & "}")).Select
End Sub

Xin bạn góp ý thêm
Cảm ơn!
---------------------

Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

Nhấp chuột vào đây để mở rộng...

Ah... xin nói thêm: Chuyện này tôi đã lường trước và code chạy tốt cho dù cho bao nhiều sheet (bạn test giúp)

vũ trung kiên · 18/11/09

Đối với đoạn code trên chỉ là vd đơn giản nên có thể làm trực tiếp hoặc thông qua lệnh Call gọi hàm Add.
Một người lập trình chuyên nghiệp là phải lập trình theo gói như cách thứ 2 gọi hàm add

ndu96081631 · 18/11/09

vũ trung kiên đã viết:
Đối với đoạn code trên chỉ là vd đơn giản nên có thể làm trực tiếp hoặc thông qua lệnh Call gọi hàm Add.
Một người lập trình chuyên nghiệp là phải lập trình theo gói như cách thứ 2 gọi hàm add

Bạn vui lòng nói rõ hơn 1 chút được không? (có ví dụ minh họa càng tốt)
Tay ngang như tôi nghe bạn nói vậy cũng bằng không... vì chẳng hiểu gì cả!
Cảm ơn trước nhé!

rollover79 · 18/11/09

anhtuan1066 đã viết:
Vẫn có chổ đáng đề học đấy bạn chứ... Chiêu hay trong này theo tôi là
Set sh = ActiveWindow.SelectedSheets
Công nhân là rất khéo léo
Đoạn code thứ 2 cũng rất ngắn gọn và tinh tế
Mình xin đưa lên giải pháp "củ chuổi" này (nói rằng củ chuối là vì phải thông qua việc xử lý chuổi)

PHP:

Sub SelectMultiSheets() Dim Temp As String, i As Long i = ActiveSheet.Index Temp = Join(Evaluate("Transpose(Row(1:" & Sheets.Count & "))"), ",") Temp = Replace(Replace(Temp, "," & i, ""), i & ",", "") Sheets(Evaluate("{" & Temp & "}")).Select End Sub

Xin bạn góp ý thêm
Cảm ơn!
---------------------

Ah... xin nói thêm: Chuyện này tôi đã lường trước và code chạy tốt cho dù cho bao nhiều sheet (bạn test giúp)

Trường hợp có 1 Sheet code này thì ok, 2 đoạn code của tôi và code trước của bác thì có vấn đề

. Với đoạn code này thuật toán thì rõ rồi, nhưng có 1 vấn đề nhỏ là nếu Workbook có nhiều hơn 9 sheet và đứng ở sheet thứ 1 để chạy code thì sẽ có vấn đề, hoặc Workbook có nhiều hơn 19 sheet và đứng ở sheet thứ 2 để chạy cũng có vấn đề, nguyên nhân là do dòng này

Mã:

  Temp = Replace(Replace(Temp, "," & i, ""), i & ",", "")

Lỗi này khi dùng Replace rất hay gặp, xin được sửa dòng code trên thành 3 dòng code sau

Mã:

  Temp = Replace("," & Temp & ",", "," & i & ",", ",")
  If Left(Temp, 1) = "," Then Temp = Mid(Temp, 2)
  If Right(Temp, 1) = "," Then Temp = Left(Temp, Len(Temp) - 1)

Sau khi sửa mà Workbook có 1 sheet thì khi chạy cũng sẽ bị lỗi, nên phải bắt trường hợp này.

Đố vui về VBA!

Thành viên gạo cội

❆❆❆❆❆❆❆❆

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

❆❆❆❆❆❆❆❆

Thành viên gạo cội

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên gạo cội

File đính kèm

Thành viên mới

Huyền thoại GPE

Thành viên tiêu biểu