Đố 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,907
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
 
Định nghĩa 1 biến dạng WorksheetFunction

Tôi có đoạn code thế này:
PHP:
Sub Test()
  MsgBox WorksheetFunction.And(1, 1)
End Sub
Code chạy không có vấn đề (MsgBox cho kết quả là TRUE)
Tôi sửa code trên thành:
PHP:
Sub Test()
  Dim Func As WorksheetFunction
  MsgBox Func.And(1, 1)
End Sub
Nghĩ rằng chẳng có vấn đề gì với code này cả, ấy thế mà khi chạy nó lại báo lổi
Xin hỏi tại sao lại vậy? Hi... Hi...
(Tin chắc không ít người đã từng gặp vấn đề này rồi)
 
Upvote 0
Tay này ra đề có chuyện rồi:
2,001Km đến 2,999Km =?
50,001Km đến 50,999Km=?

hihihi! Vâng tất nhiên là em có chuyện mới viết đề thế này chứ! hihihi
Đề này mục đích không phải là xử lý cho đúng trường hợp. Còn chuyện lỗi kia là cố ý đó.
Các bác viết Function() Nhưng chỉ được dùng 1 IF để xử lý trường hợp lỗi kia thôi nhé! <Thuật toán mà>
Các trường hợp dễ thì mọi người viết rồi. Giờ tới lúc nâng cao nào?!
Thân.
 
Upvote 0
Đề 2:
Hãy cho biết năm X này là năm nhuận hay thường?
+Có 2 trường hợp sử lý năm nhuận như sau:
-Trường hợp năm đầu thế kỷ <như 1800, 1900, 2000,...> thì nó chia hết cho 400 thì nhuận <Ngược lại thì không>
-Trường hợp năm thường <như 1986,...> thì nó chia hết cho 4 thì nhuận <Ngược lại thì không>

Với đề này chắc là hơi dể nhỉ? Nên em đề nghị viết 2 cách giải trở lên và cách sau phải ngắn hơn cách trước nha.
Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Người đi đầu dễ va vấp nhưng có chùng cho người sau bước. Mình dùng công thức chỉ có 1 if(), ô có Name là Nam chứa giá trị năm:


=IF(OR(AND(MOD(Nam,100)<>0,MOD(Nam,4)=0),AND(MOD(Nam,100)=0,MOD(Nam,400)=0)),"Nhuan","Khong")
 
Upvote 0
Đề 2:
Hãy cho biết năm X này là năm nhuận hay thường?
+Có 2 trường hợp sử lý năm nhuận như sau:
-Trường hợp năm đầu thế kỷ <như 1800, 1900, 2000,...> thì nó chia hết cho 400 thì nhuận <Ngược lại thì không>
-Trường hợp năm thường <như 1986,...> thì nó chia hết cho 4 thì nhuận <Ngược lại thì không>

Với đề này chắc là hơi dể nhỉ? Nên em đề nghị viết 2 cách giải trở lên và cách sau phải ngắn hơn cách trước nha.
Thân.
Rất nhiều người bản cải về vụ năm nhuận này... Tôi thì cho rằng chúng ta đang làm việc trên Excel thì cớ gì phải đi tính toán cái đã có sẳn chứ!
Xem ngày trong tháng 2 của năm X, nếu là là 29 thì NHUẬN, ngược lại thì KHÔNG NHUẬN
Tất cả dựa vào ngày này: DAY(DATE(X,3,0)) mà IF ---> Đơn giản thế thôi!
Việc năm ấy thuộc năm đầu thế kỷ hay.. gì gì đó, đã có Excel lo hộ cho ta rồi
 
Lần chỉnh sửa cuối:
Upvote 0
Sự khác nhau giữa 2 cách xử lý Range

- Tôi có 1 vùng được đặt tên trong Define Name là Data
- Tôi có 2 đoạn code như sau:
PHP:
Sub Test1()
  With Range("Data")
    .Offset(.Rows.Count, .Columns.Count).Resize(1, 1).Select
  End With
End Sub

PHP:
Sub Test2()
  With Range("Data")
    .Resize(1, 1).Offset(.Rows.Count, .Columns.Count).Select
  End With
End Sub
Thử suy nghĩ xem 2 đoạn này khác nhau ở điểm quan trọng nào?
Hay nói chính xác hơn thì theo ý các bạn, ta nên dùng đoạn code nào là hợp lý?
(câu này khá dể, mời thử sức nha)
 
Upvote 0
Làm sao phát hiện được tình huống "CHƯA GÕ GÌ VÀO INPUTBOX"

Tôi có đoạn code như sau:
PHP:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  .... Làm công việc tiếp theo ...
End Sub
Ý tôi muốn rằng: Nếu thật sự tôi có gõ gì vào InputBox thì mới "Làm công việc tiếp theo", ngược lại thì không làm gì cả!
--------------------------------
Tôi đã thí nghiệm:
PHP:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 then
  .... Làm công việc tiếp theo ...
  End If
End Sub
===> Cóc được
PHP:
 Sub Test()
   Dim Text As String
   Text = Application.InputBox("Go gi do vao day!", Type:=2)
   If Text <> "" then
   .... Làm công việc tiếp theo ...
  End If
 End Sub
Cũng.. cóc được luôn!
------------------------------------------
Xin hỏi các bạn ta phải xử lý thế nào?
------------------------------------------
(Bài này rất dể nhưng hơi bị.. tức đây!)
Ẹc.. Ẹc...
 
Upvote 0
Anh ơi,
Anh nói em chưa hiểu lắm.
Em thử đoạn code của anh
Mã:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 Then
    MsgBox "Hello"
  '
  End If
End Sub
Em thử nhập vào thì nó vẫn thực hiện các lệnh tiếp theo chứ anh?

Lê Văn Duyệt
 
Upvote 0
Anh ơi,
Anh nói em chưa hiểu lắm.
Em thử đoạn code của anh
Mã:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 Then
    MsgBox "Hello"
  '
  End If
End Sub
Em thử nhập vào thì nó vẫn thực hiện các lệnh tiếp theo chứ anh?

Lê Văn Duyệt
Thế Duyệt có thử bấm Cancel chưa? ---> Ẹc.. Ẹc...
Đấy mới là vấn đề
Tóm lại: Code của Duyệt dù có Cancel hay OK thì.. VẪN NHƯ NHAU!
 
Upvote 0
Thế Duyệt có thử bấm Cancel chưa? ---> Ẹc.. Ẹc...
Đấy mới là vấn đề
Tóm lại: Code của Duyệt dù có Cancel hay OK thì.. VẪN NHƯ NHAU!
Hi anh, cái này không phải code của em. Hi hi hi.

Vậy thì anh xem cái code này (chỉ là ví dụ tham khảo thôi):
Mã:
Sub RangeDataType()

Dim rRange As Range
    [COLOR="red"]On Error Resume Next[/COLOR]
        Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)
    [COLOR="red"]On Error GoTo 0[/COLOR]
        [COLOR="red"]Application.DisplayAlerts = True[/COLOR]
        If rRange Is Nothing Then
            Exit Sub
        Else
            rRange.Font.Bold = True
        End If
End Sub
Chú ý mấy cái màu đỏ đỏ.
Nguồn từ đây
Theo em về cơ bản để trả lời câu hỏi của anh thì phải biết được cấu trúc của Application.InputBox.

Lê Văn Duyệt
 
Upvote 0
Hi anh, cái này không phải code của em. Hi hi hi.

Vậy thì anh xem cái code này (chỉ là ví dụ tham khảo thôi):
Mã:
Sub RangeDataType()

Dim rRange As Range
    [COLOR=red]On Error Resume Next[/COLOR]
        Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)
    [COLOR=red]On Error GoTo 0[/COLOR]
        [COLOR=red]Application.DisplayAlerts = True[/COLOR]
        If rRange Is Nothing Then
            Exit Sub
        Else
            rRange.Font.Bold = True
        End If
End Sub
Chú ý mấy cái màu đỏ đỏ.
Nguồn từ đây
Theo em về cơ bản để trả lời câu hỏi của anh thì phải biết được cấu trúc của Application.InputBox.

Lê Văn Duyệt
Nếu là Range thì dể rồi, Với biến Range tôi thường làm vầy:
PHP:
Sub Test()
  Dim SrcRng As Range
  On Error Resume Next
  Set SrcRng = Application.InputBox("Chon vung", Type:=8)
  If Not SrcRng Is Nothing Then
    MsgBox SrcRng.Address
  End If
End Sub
Trước giờ xài tốt, hoàn toàn không có vấn đề gì... Nhưng ở đây cái ta nhập vào InputBox là dạng chuổi (Type:=2) ---> dù Duyệt có nhập hay không nhập vào InputBox thì chuổi ấy vẫn tồn tại ---> Vậy có gì phân biệt giữa việc CÓ NHẬP và KHÔNG NHẬP?
Thế mới "khoai" chứ!
Không biết các bạn khác có ai từng gặp tình huống này không nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
Theo em:
CÓ NHẬP
Len(...)>0
KHÔNG NHẬP
1. Cancel
2. Len(...)=0

Ở đây vấn đề là anh nói trường hợp 2. Vậy thì với ví dụ trên anh chỉ việc thay thế theo ý anh thôi.
Chú ý:
1. Có nhập vào thì len(text)>0 và text<>False
2. Nếu người dùng Cancel hay Esc, text=False
3. Nếu không nhập vào mà nhấn OK thì Len(text)=0

Lê Văn Duyệt
 
Upvote 0
Theo em:
CÓ NHẬP
Len(...)>0
KHÔNG NHẬP
1. Cancel
2. Len(...)=0

Ở đây vấn đề là anh nói trường hợp 2. Vậy thì với ví dụ trên anh chỉ việc thay thế theo ý anh thôi.
Chú ý:
1. Có nhập vào thì len(text)>0 và text<>False
2. Nếu người dùng Cancel hay Esc, text=False
3. Nếu không nhập vào mà nhấn OK thì Len(text)=0

Lê Văn Duyệt
Chính xác đến... 99.99%
Tức sửa lại code như sau:
PHP:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 And Text <> "False" Then
    MsgBox Text
  End If
End Sub
Chỉ có 1 vấn đề nhỏ xíu nữa, đó là nếu tôi gõ chữ False vào InputBox thì lý ra cũng phải xuất hiện MsgBox (vì tôi có gõ vào mà)... đàng này nó chẳng làm gì cả!
Tóm lại:
- Nếu tôi bấm Cancel thì Text trả về giá trị = False
- Vậy nếu tôi gõ vào chữ False thì có gì phân biệt giữa trường hợp này với trường hợp bấm nút Cancel?
--------------------------------------------------------------------------------
(Bởi vậy mới nói đây là bài dể nhưng mà cũng rất.. dể tức...)
Tuy nhiên đây vẫn là cách xử lý tốt nhất cho đến thời điểm hiện giờ!
Cảm ơn Duyệt!
--------------------------------------------------------------------------------
Vẫn còn 1 cách khác tuyệt đối chính xác (100%) ngay cả trường hợp gõ chữ False vào InputBox ---> Mời các cao thủ nghiên cứu
Lưởi câu đây nha! Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
Chính xác đến... 99.99%
Tức sửa lại code như sau:
PHP:
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 And Text <> "False" Then
    MsgBox Text
  End If
End Sub
Chỉ có 1 vấn đề nhỏ xíu nữa, đó là nếu tôi gõ chữ False vào InputBox thì lý ra cũng phải xuất hiện MsgBox (vì tôi có gõ vào mà)... đàng này nó chẳng làm gì cả!
Tóm lại:
- Nếu tôi bấm Cancel thì Text trả về giá trị = False
- Vậy nếu tôi gõ vào chữ False thì có gì phân biệt giữa trường hợp này với trường hợp bấm nút Cancel?
--------------------------------------------------------------------------------
(Bởi vậy mới nói đây là bài dể nhưng mà cũng rất.. dể tức...)
Tuy nhiên đây vẫn là cách xử lý tốt nhất cho đến thời điểm hiện giờ!
Cảm ơn Duyệt!
--------------------------------------------------------------------------------
Vẫn còn 1 cách khác tuyệt đối chính xác (100%) ngay cả trường hợp gõ chữ False vào InputBox ---> Mời các cao thủ nghiên cứu
Lưởi câu đây nha! Ẹc... Ẹc...
Theo tôi thì tùy từng trường hợp mà xử lý, ở đây bạn muốn lấy về dữ liệu kiểu chuỗi, vậy đơn giản hơn là ta dùng hàm InputBox thay cho phương thức Application.InputBox là ok ngay. Về phía người dùng sẽ không thấy có sự khác nhau. Sử dụng phương thức Application.InputBox thì hơn ở chỗ là áp được kiểu của người dùng nhập vào do đó không cần phải xử lý về kiểu nữa. Còn ở đây có lẽ là bác NDU đang định đánh đố với trường hợp cụ thể này thì phải. Nếu vậy thì có thể tạm dùng cách như sau:
Mã:
Sub Test()
    Dim Text ' As String
    Text = Application.InputBox("Go gi do vao day!", Type:=2)
    If Len(Text) > 0 And TypeName(Text) = "String" Then
        MsgBox Text
    End If
End Sub
Tuy nhiên nếu Type không phải là 2 mà thay vào đó là 4 thì tôi không rõ là phải giải quyết ra sao.
 
Upvote 0
Không phân biệt được giữa người dùng nhập vào "Cancel" hay người dùng nhấn "Cancel" đây là vấn đề nhiều người đã bàn (các forum nước ngoài cũng vậy)
Đúng là ta chỉ tuỳ trường hợp mà làm thôi. Nếu trong trường hợp là số thì lại gặp vấn đề giữa "0" nhập vào vào việc người dùng nhấn "cancel". Vì lúc này khi người dùng nhấn "cancel" thì cũng trả về giá trị là "0".
Tham khảo thêm:
Mã:
Sub Using_InputBox_Function()
      Dim Show_Box As Boolean
      Dim Response As Variant

      ' Set the Show_Dialog variable to True.
      Show_Box = True

      ' Begin While loop.
      While Show_Box = True

         ' Show the input box.
         Response = InputBox("Enter a number.", _
            "Number Entry", , 250, 75)

         ' See if Cancel was pressed.
         If Response = "" Then

            ' If Cancel was pressed,
            ' break out of the loop.
            Show_Box = False
         Else
            ' Test Entry to find out if it is numeric.
            If IsNumeric(Response) = True Then
               ' Write the number to the first
               ' cell in the first sheet in the active
               ' workbook.
               Worksheets(1).Range("a1").Value = Response
               Show_Box = False
            Else
               ' If the entry was wrong, show an error message.
               MsgBox "Please Enter Numbers Only"
            End If
         End If
      ' End the While loop.
      Wend
   End Sub
Từ Mr.M$


Lê Văn Duyệt
PS: trả lời tàm tạm không biết anh Tuấn có đãi gì không nữa.
 
Upvote 0
Theo tôi thì tùy từng trường hợp mà xử lý, ở đây bạn muốn lấy về dữ liệu kiểu chuỗi, vậy đơn giản hơn là ta dùng hàm InputBox thay cho phương thức Application.InputBox là ok ngay. Về phía người dùng sẽ không thấy có sự khác nhau.
Ẹc... Ẹc... Chuẩn không còn gì để chỉnh nữa
rollover79 mà ra tay thì... TUYỆT!
(Lưu ý: Ở đây đang xét trường hợp là CHUỔI)
-----------------------
Với levanduyet:
Để mình nghiên cứu lại code của Duyệt cái đã... (nó hơi bị cao siêu)
Nhưng nói chung, đã là đố vui thì chủ yếu dựa vào MẸO thôi ---> Không cố tình gây rắc rối về code (mà thật sự mình cũng không đủ khả năng để GÂY RẮC RỐI)
 
Lần chỉnh sửa cuối:
Upvote 0
Anh ơi,
Ans đã viết:
dùng hàm InputBox thay cho phương thức Application.InputBox
Cái này cần phải xem lại. Nếu chỉ nói đến chuỗi thôi thì em nghĩ cũng chấp nhận được.

Lê Văn Duyệt
 
Upvote 0
Sai sót với hàm UniqueList

Trên diển đàn có rất nhiều bài viết về việc dùng Dictionary Object để lấy list duy nhất! Nay xin đưa lên 1 ví dụ nhỏ dùng làm câu đố vui
- Tôi có dữ liệu như hình:

untitled..JPG

- Tôi có đoạn code:
PHP:
Function UniqueList(SrcArray)
  Dim Item
  With CreateObject("Scripting.Dictionary")
    For Each Item In SrcArray
      If Not .Exists(Item) And Item <> "" Then .Add Item, ""
    Next
    UniqueList = .Keys
  End With
End Function
Nhìn sơ qua chưa thấy có gì không ổn cả, vậy mà khi kiểm tra thì:
a) Công thức =SUMPRODUCT(1/COUNTIF(A1:A6,A1:A6)) cho kết quả =3
b) Công thức =COUNTA(UniqueList(A1:A6)) lại cho kết quả = 6
c) Quét chọn đoạn UniqueList(A1:A6) trên thanh Formula rồi bấm F9 ta nhìn thấy kết quả {"a","b","c","a","b","c"}
d) Có vẽ như hàm trên chẳng lọc được danh sách duy nhất gì cả, có bao nhiêu nó lấy hết
------------------------------
Xin hỏi hàm trên cần sửa lại chổ nào?
Xin lưu ý rằng: Tôi muốn biến SrcArrayItem phải là Variant (để có thể làm việc được với Range và cả Array)
 

File đính kèm

  • UniqueList_Test.xls
    18.5 KB · Đọc: 24
Upvote 0
Anh ơi,
Mã:
With CreateObject("Scripting.Dictionary")
        If Not TypeOf SrcArray Is Range Then
            For Each Item In SrcArray
                If Not .Exists(Item) And Item <> "" Then .Add Item, ""
            Next
        Else
            For Each Item In SrcArray.Value
                If Not .Exists(Item) And Item <> "" Then .Add Item, ""
            Next
        End If
        UniqueList = .Keys
End With

PS: Anh ơi làm hoài không có thưởng gì hết. Hu hu hu !
 
Lần chỉnh sửa cuối:
Upvote 0
Anh ơi,
Mã:
If Not TypeOf SrcArray Is Range Then
With CreateObject("Scripting.Dictionary")
For Each Item In SrcArray
If Not .Exists(Item) And Item <> "" Then
.Add Item, ""
Debug.Print Item
End If
Next
UniqueList = .Keys
End With
Else
With CreateObject("Scripting.Dictionary")
For Each Item In SrcArray.Value
If Not .Exists(Item) And Item <> "" Then
.Add Item, ""
Debug.Print Item
End If
Next
UniqueList = .Keys
End With
 
End If
Hi... hi... Chính xác! Nhưng đâu cần búa to thế Duyệt ơi!
Còn cách khác, chỉ thêm duy nhất 1 dòng code (cực ngắn)
(Dù sao cũng lại học được thêm chiêu TypeOf SrcArray Is Range)
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT
Back
Top Bottom