Đố 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

VetMini · 5/9/13

Lâu ngày không làm toán sắp mảng so le nên quên mất. Code trên còn thiếu một đoạn chép nốt phần đuôi. Sở dĩ lúc chạy thử không thấy sai là vì dữ liệu thử hơi đặc thù: hai cột B và C đều kết bởi 2 dòng tháng 10. Nếu không có điều kiện này thì đã chạy ra sai.

Phải thêm khúc này sau vòng lạp WHEN để chép nốt phần đuôi:

Mã:

For ib1 = ib1 to szb
i2 = i2 + 1
b2(i2) = Format(b1(ib1), "yyyy-mm-dd")
Next ib1

For ic1 = ic1 to szc
i2 = i2 + 1
c2(i2) = Format(c1(ic1), "yyyy-mm-dd")
Next ib1

dhn46 · 5/9/13

ndu96081631 đã viết:
Thì cứ thử xem! Ai mà biết đâu chứ
Ẹc... Ẹc...

Đợi mãi không thấy ai trả lời, em "liều" với cái này vậy

1/ Tạo 1 file Test.txt tại ổ D với nôi dung:

Mã:

Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Sub StartTimer()
    StopTimer
    SetTimer Application.hWnd, nIDEvent, 1000, AddressOf TimeProc
End Sub
Sub StopTimer()
    KillTimer Application.hWnd, nIDEvent
End Sub
Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
    If Application.ActiveCell.Address <> "$A$1" Then
        Application.StatusBar = [a1]
    End If
End Function
Sub Auto_Open()
    StartTimer
End Sub

2/ Chạy Code sau trên file A.xls

Mã:

Sub ImportModule()
  Workbooks.Open ThisWorkbook.Path & "\B.xls"
  ExecuteExcel4Macro ("VBA.INSERT.FILE(""D:\Test.txt"")")
  ActiveWorkbook.Save
  ActiveWorkbook.Close
End Sub

ndu96081631 · 5/9/13

dhn46 đã viết:

Đợi mãi không thấy ai trả lời, em "liều" với cái này vậy

1/ Tạo 1 file Test.txt tại ổ D với nôi dung:

Mã:

Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Sub StartTimer()
    StopTimer
    SetTimer Application.hWnd, nIDEvent, 1000, AddressOf TimeProc
End Sub
Sub StopTimer()
    KillTimer Application.hWnd, nIDEvent
End Sub
Function TimeProc(ByVal H As Long, ByVal nMSG As Long, ByVal nID As Long, ByVal nTsys As Long)
    If Application.ActiveCell.Address <> "$A$1" Then
        Application.StatusBar = [a1]
    End If
End Function
Sub Auto_Open()
    StartTimer
End Sub

2/ Chạy Code sau trên file A.xls

Mã:

Sub ImportModule()
  Workbooks.Open ThisWorkbook.Path & "\B.xls"
  ExecuteExcel4Macro ("VBA.INSERT.FILE(""D:\Test.txt"")")
  ActiveWorkbook.Save
  ActiveWorkbook.Close
End Sub

Gần gần đúng rồi đấy (tức là đạt yêu cầu) ---> Chính xác 1 điểm VBA.INSERT.FILE
Nhưng nếu tôi làm thì sẽ là những code rất bình thường (không API gì cả) ---> Thế mới.. VUI
Ẹc... Ẹc...

ndu96081631 · 5/9/13

Chắc không ai tham gia nữa rồi. Đưa đáp án lên luôn

Mã:

Private Sub ImportCode(ByVal ExcelFile As String, ByVal VBACode As String)
  Dim tmpFile, wkb As Workbook
  On Error GoTo ExitSub
  Application.ScreenUpdating = False
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    With .OpenTextFile(tmpFile, 2, True)
      .Write VBACode: .Close
    End With
  End With
  Set wkb = Workbooks.Open(ExcelFile)
  ExecuteExcel4Macro ("VBA.INSERT.FILE(""" & tmpFile & """)")
  wkb.Close (True)
  Kill tmpFile
ExitSub:
  Application.ScreenUpdating = True
End Sub

Sub Main()
  Dim ExcelFile As String, VBACode As String
  ExcelFile = ThisWorkbook.Path & "\B.xls"
  VBACode = "Sub Auto_Open()" & vbLf & _
            "ActiveSheet.OnEntry = ""Main""" & vbLf & _
            "End Sub" & vbLf & _
            "Sub Main()" & vbLf & _
            "If ActiveCell.Address = ""$A$1"" Then Application.StatusBar = ActiveCell.Value" & vbLf & _
            "End Sub"
  ImportCode ExcelFile, VBACode
End Sub

Code này trong file A.xls. Chạy Sub Main, đóng file A, mở file B lên sẽ thấy kết quả

dhn46 · 5/9/13

Hay quá thầy ah. Em search lại thấy Topic này cũng đã đố về cái em "OnEntry" này rồi mà giờ em mới biết.

ndu96081631 · 6/9/13

dhn46 đã viết:
Hay quá thầy ah. Em search lại thấy Topic này cũng đã đố về cái em "OnEntry" này rồi mà giờ em mới biết.

Tức là kiến thức không mới, vấn đề là phối hợp nhiều cái cũ lại cho ra 1 cái mới hơn (khiến ta ngạc nhiên)
Ẹc... Ẹc...
Qua đây mới thấy rằng: Dù 1 file có pass VBA, tôi không cần phải crack gì cả cũng có thể khiến cho file ấy "banh ta long" như thường (phá hoại)

Hoàng Trọng Nghĩa · 16/9/13

Để tạo không khí mới, tôi đố các bạn về LISTBOX nhé!

Tôi có 1 UserForm, trong đó có 1 ListBox và 1 CommandButton.

Với ListBox tôi đặt thuộc tính MultiSelect

Khi Show Form, tôi chạy thủ tục sau:

Mã:

Private Sub UserForm_Initialize()
    Dim i As Long
    For i = 1 To 10000
[COLOR=#008000]        ''Add item for ListBox:[/COLOR]
[COLOR=#0000ff]        Me.ListBox1.AddItem "Nghia dep trai " & i[/COLOR]
[COLOR=#008000]        ''Check all of items on ListBox:[/COLOR]
[COLOR=#800080]        Me.ListBox1.Selected(i - 1) = True[/COLOR]
    Next
End Sub

Khi Form được show, các bạn sẽ thấy các mục trong ListBox được CHECK và được SELECT toàn bộ.

Câu đố đặt ra là:

Gán thủ tục nào đó vào CommandButton mà khi ta bấm vào nó BỎ CHỌN (UNCHECK) tất cả các mục đã chọn trong ListBox một cách nhanh nhất, ngắn gọn nhất!

Xin lưu ý:

Không chơi cái này nha: Me.ListBox1.MultiSelect = fmMultiSelectSingle

Bởi khi làm như thế nó mất đi thuộc tính ban đầu ta gán cho nó roài!

ndu96081631 · 16/9/13

Hoàng Trọng Nghĩa đã viết:
Câu đố đặt ra là:

Gán thủ tục nào đó vào CommandButton mà khi ta bấm vào nó BỎ CHỌN (UNCHECK) tất cả các mục đã chọn trong ListBox một cách nhanh nhất, ngắn gọn nhất!

Vầy chắc được:

Mã:

Me.ListBox1.MultiSelect = 0

nghiaphuc · 16/9/13

Hoàng Trọng Nghĩa đã viết:
Để tạo không khí mới, tôi đố các bạn về LISTBOX nhé!

Tôi có 1 UserForm, trong đó có 1 ListBox và 1 CommandButton.

Với ListBox tôi đặt thuộc tính MultiSelect

Khi Show Form, tôi chạy thủ tục sau:

Mã:

Private Sub UserForm_Initialize() Dim i As Long For i = 1 To 10000 [COLOR=#008000] ''Add item for ListBox:[/COLOR] [COLOR=#0000ff] Me.ListBox1.AddItem "Nghia dep trai " & i[/COLOR] [COLOR=#008000] ''Check all of items on ListBox:[/COLOR] [COLOR=#800080] Me.ListBox1.Selected(i - 1) = True[/COLOR] Next End Sub

Khi Form được show, các bạn sẽ thấy các mục trong ListBox được CHECK và được SELECT toàn bộ.

Câu đố đặt ra là:

Gán thủ tục nào đó vào CommandButton mà khi ta bấm vào nó BỎ CHỌN (UNCHECK) tất cả các mục đã chọn trong ListBox một cách nhanh nhất, ngắn gọn nhất!

"Ăn gian" kiểu này có được chấp nhận không anh Nghĩa nhỉ:
[GPECODE=vb]Private Sub CommandButton1_Click()
ListBox1.MultiSelect = fmMultiSelectSingle
ListBox1.MultiSelect = fmMultiSelectMulti
End Sub[/GPECODE]

ndu96081631 · 16/9/13

Hoàng Trọng Nghĩa đã viết:
Không chơi cái này nha: Me.ListBox1.MultiSelect = fmMultiSelectSingle

Vụ gì vậy?
CHƠI xong, đi rửa tay phát như nghiaphuc là được rồi

Hoàng Trọng Nghĩa · 16/9/13

ndu96081631 đã viết:
Vầy chắc được:

Mã:

Me.ListBox1.MultiSelect = 0

nghiaphuc đã viết:
"Ăn gian" kiểu này có được chấp nhận không anh Nghĩa nhỉ:
[GPECODE=vb]Private Sub CommandButton1_Click()
ListBox1.MultiSelect = fmMultiSelectSingle
ListBox1.MultiSelect = fmMultiSelectMulti
End Sub[/GPECODE]

Xin lỗi, mình đã bổ sung sau dòng này, các Thầy trả lời nhanh quá!

Hoàng Trọng Nghĩa đã viết:
Xin lưu ý:

Không chơi cái này nha: Me.ListBox1.MultiSelect = fmMultiSelectSingle

Bởi khi làm như thế nó mất đi thuộc tính ban đầu ta gán cho nó roài!

Hoàng Trọng Nghĩa · 16/9/13

ndu96081631 đã viết:
Vụ gì vậy?
CHƠI xong, đi rửa tay phát như nghiaphuc là được rồi

Chấp luôn! Vậy còn cách nào ngắn hơn nữa không?

nghiaphuc · 16/9/13

ndu96081631 đã viết:
Vụ gì vậy?
CHƠI xong, đi rửa tay phát như nghiaphuc là được rồi

Em cũng "giật mình", lúc đang mò mẫm thì không thấy cái vụ này, đến hồi gửi bài lên mới thấy dòng này, hóa ra anh Nghĩa mới sửa bài. Hic hic...

ndu96081631 · 16/9/13

nghiaphuc đã viết:
Em cũng "giật mình", lúc đang mò mẫm thì không thấy cái vụ này, đến hồi gửi bài lên mới thấy dòng này, hóa ra anh Nghĩa mới sửa bài. Hic hic...

Nếu như CẤM CHƠI thì tui HIẾP luôn:

Mã:

Me.ListBox1.List() = Me.ListBox1.List

Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 16/9/13

ndu96081631 đã viết:
Nếu như CẤM CHƠI thì tui HIẾP luôn:

Mã:

Me.ListBox1.List() = Me.ListBox1.List

Ẹc... Ẹc...

Đúng là đố vui, trả lời cũng vui thiệt! Nhưng như thế thì thời gian có kéo dài quá không nhỉ?

nghiaphuc · 16/9/13

ndu96081631 đã viết:
Nếu như CẤM CHƠI thì tui HIẾP luôn:

Mã:

Me.ListBox1.List() = Me.ListBox1.List

Ẹc... Ẹc...

Trời đất, nhanh hơn điện! Em cũng vừa mới phát hiện ra, vừa định gửi thì đã thấy bài này rồi. Zui thiệt!

Hoàng Trọng Nghĩa · 16/9/13

nghiaphuc đã viết:
Trời đất, nhanh hơn điện! Em cũng vừa mới phát hiện ra, vừa định gửi thì đã thấy bài này rồi. Zui thiệt!

Sau khi thử xong, nó nhanh thiệt! Tưởng đâu nó add list bằng mảng của chính nó chậm chứ! Thật sự dùng List nhanh vô địch nhỉ?

nghiaphuc · 16/9/13

Hoàng Trọng Nghĩa đã viết:
Sau khi thử xong, nó nhanh thiệt! Tưởng đâu nó add list bằng mảng của chính nó chậm chứ! Thật sự dùng List nhanh vô địch nhỉ?

Ý em nói nhanh là anh Tuấn nhanh cơ. Code chạy cũng mượt mà, màn hình không hề giựt. Cái chiêu gán List này anh Tuấn cũng có một vài lần đề cập đến trong topic này, nhưng mà với mục đích khác (gán list một lần, xài mãi mãi).

Hoàng Trọng Nghĩa · 16/9/13

nghiaphuc đã viết:
Ý em nói nhanh là anh Tuấn nhanh cơ. Code chạy cũng mượt mà, màn hình không hề giựt. Cái chiêu gán List này anh Tuấn cũng có một vài lần đề cập đến trong topic này, nhưng mà với mục đích khác (gán list một lần, xài mãi mãi).

Anh nói là nó gán mảng vào ListBox thì nhanh vô địch, nhưng việc UnCheck còn có thủ tục đơn giản hơn và anh nghĩ sẽ nhanh hơn nữa đấy! Tiếp tục tìm cách khác xem có đúng đáp án của mình không nhé!

nghiaphuc · 16/9/13

Hoàng Trọng Nghĩa đã viết:
Anh nói là nó gán mảng vào ListBox thì nhanh vô địch, nhưng việc UnCheck còn có thủ tục đơn giản hơn và anh nghĩ sẽ nhanh hơn nữa đấy! Tiếp tục tìm cách khác xem có đúng đáp án của mình không nhé!

Chẳng biết có nhanh hơn hay không nhưng có một cách "ăn gian" nữa là như vầy:
[GPECODE=vb]Private Sub CommandButton1_Click()
ListBox1.ColumnCount = ListBox1.ColumnCount + 1
ListBox1.ColumnCount = ListBox1.ColumnCount - 1
End Sub[/GPECODE]

Đố vui về VBA!

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

Ăn cùng góc phố

Hướng tới tương lai

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Hướng tới tương lai

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

Huyền thoại GPE

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

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

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

Huyền thoại GPE

Chuyên gia GPE

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

Chuyên gia GPE

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

Chuyên gia GPE

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