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

thanhlanh · 25/1/13

ndu96081631 đã viết:
Thì có KHÓ mới ĐỐ chứ
Nhưng đã là ĐỐ VUI thì giải pháp luôn rất đơn giản
Cố lên. Ẹc... Ẹc...

Mình cũng đã cố thử nhưng không được, nghi là tạo module class nhưng không biết làm, hic

Hoàng Trọng Nghĩa · 25/1/13

Trong khi chờ đợi câu trả lời của bài gán text cho label, mình xin "câu khách" một câu đố đơn giản!

Mình có một chuỗi bất kỳ, muốn loại bỏ 5 ký tự đầu, dùng HÀM gì trong VBA để cắt bỏ 5 ký tự đó mà CHỈ DÙNG ĐÚNG 1 HÀM

VD như vầy là dùng 2 hàm: MID(txt, 5, LEN(txt)) thì xem như giải không đúng yêu cầu!

nghiaphuc · 25/1/13

Hoàng Trọng Nghĩa đã viết:
Trong khi chờ đợi câu trả lời của bài gán text cho label, mình xin "câu khách" một câu đố đơn giản!

Mình có một chuỗi bất kỳ, muốn loại bỏ 5 ký tự đầu, dùng HÀM gì trong VBA để cắt bỏ 5 ký tự đó mà CHỈ DÙNG ĐÚNG 1 HÀM

VD như vầy là dùng 2 hàm: MID(txt, 5, LEN(txt)) thì xem như giải không đúng yêu cầu!

Em thay cái hàm LEN đó thành 1 con số thiệt là bự có được không anh Nghĩa?

ndu96081631 · 25/1/13

Hoàng Trọng Nghĩa đã viết:
Trong khi chờ đợi câu trả lời của bài gán text cho label, mình xin "câu khách" một câu đố đơn giản!

Mình có một chuỗi bất kỳ, muốn loại bỏ 5 ký tự đầu, dùng HÀM gì trong VBA để cắt bỏ 5 ký tự đó mà CHỈ DÙNG ĐÚNG 1 HÀM

VD như vầy là dùng 2 hàm: MID(txt, 5, LEN(txt)) thì xem như giải không đúng yêu cầu!

Vầy chắc được:

Mã:

Sub Test()
  Dim txt As String
  txt = "Hoang Trong Nghia"
  MsgBox Mid(txt, 5)
End Sub

Hoàng Trọng Nghĩa · 25/1/13

nghiaphuc đã viết:
Em thay cái hàm LEN đó thành 1 con số thiệt là bự có được không anh Nghĩa?

hihihi, đương nhiên nó sẽ ra kết quả đúng, tuy nhiên như vậy thì không hay lắm! Thử tìm hàm khác hàm MID, RIGHT xem sao!

Quang_Hải · 25/1/13

Hoàng Trọng Nghĩa đã viết:
Trong khi chờ đợi câu trả lời của bài gán text cho label, mình xin "câu khách" một câu đố đơn giản!

Mình có một chuỗi bất kỳ, muốn loại bỏ 5 ký tự đầu, dùng HÀM gì trong VBA để cắt bỏ 5 ký tự đó mà CHỈ DÙNG ĐÚNG 1 HÀM

VD như vầy là dùng 2 hàm: MID(txt, 5, LEN(txt)) thì xem như giải không đúng yêu cầu!

Thử vầy coi sao. Chỉ 1 mà thôi đấy

PHP:

Sub test()
Dim chuoi
chuoi = 123456789
MsgBox Replace(chuoi, "", "", 6)
End Sub

Hoàng Trọng Nghĩa · 25/1/13

quanghai1969 đã viết:
Thử vầy coi sao. Chỉ 1 mà thôi đấy

PHP:

Sub test() Dim chuoi chuoi = 123456789 MsgBox Replace(chuoi, "", "", 6) End Sub

OK, cuối cùng quanghai đúng với đáp án của mình!

Mình đã thử các trường hợp, nhưng thời gian ngang ngang nhau, các bạn thử với mình xem cái nào là nhanh nhất, các bạn thử dữ liệu với cả cột thử xem sao!

Mã:

Sub test1()
    Dim Arr, i As Long, t As Double
    t = Timer
    [C:C].Clear
    Arr = [A:A]
    For i = 1 To 65536
        Arr(i, 1) = Right(Arr(i, 1), Len(Arr(i, 1)) - 36)
    Next
    [C:C] = Arr
    MsgBox Timer - t
End Sub

Sub test2()
    Dim Arr, i As Long, t As Double
    t = Timer
    [D:D].Clear
    Arr = [A:A]
    For i = 1 To 65536
        Arr(i, 1) = Replace(Arr(i, 1), "", "", 37)
    Next
    [D:D] = Arr
    MsgBox Timer - t
End Sub

Sub test3()
    Dim Arr, i As Long, t As Double
    t = Timer
    [E:E].Clear
    Arr = [A:A]
    For i = 1 To 65536
        Arr(i, 1) = Mid(Arr(i, 1), 37)
    Next
    [E:E] = Arr
    MsgBox Timer - t
End Sub

ndu96081631 · 25/1/13

Hoàng Trọng Nghĩa đã viết:
OK, cuối cùng quanghai đúng với đáp án của mình!

Mình đã thử các trường hợp, nhưng thời gian ngang ngang nhau, các bạn thử với mình xem cái nào là nhanh nhất, các bạn thử dữ liệu với cả cột thử xem sao!

Bậy không!
Test vậy sao công bằng với hàm RIGHT (vì bắt nó tính toán 2 lần)
Phải vầy mới đúng:

Mã:

Sub test1()
  Dim Arr, i As Long, t As Double, tmp As String
  t = Timer
  [C:C].Clear
  Arr = [A:A]
  For i = 1 To 60000
    tmp = Arr(i, 1)
    Arr(i, 1) = Right(tmp, Len(tmp) - 36)
  Next
  [C:C] = Arr
  MsgBox Timer - t
End Sub

Mã:

Sub test2()
  Dim Arr, i As Long, t As Double, tmp As String
  t = Timer
  [D:D].Clear
  Arr = [A:A]
  For i = 1 To 60000
    tmp = Arr(i, 1)
    Arr(i, 1) = Replace(tmp, "", "", 37)
  Next
  [D:D] = Arr
  MsgBox Timer - t
End Sub

Mã:

Sub test3()
  Dim Arr, i As Long, t As Double, tmp As String
  t = Timer
  [E:E].Clear
  Arr = [A:A]
  For i = 1 To 60000
    tmp = Arr(i, 1)
    Arr(i, 1) = Mid(tmp, 37)
  Next
  [E:E] = Arr
  MsgBox Timer - t
End Sub

Test xong, 3 code cho kết quả gần như nhau (trên máy tôi là 1.2s)

Hoàng Trọng Nghĩa · 28/1/13

ndu96081631 đã viết:
Nghe qua thì rất có lý, nhưng nên biết rằng topic này là BÀN VỀ VBA, tức là VIẾT CODE
Làm bằng tay xem như đã thông qua, vậy chúng ta viết code thế nào để ra được kết quả như vậy?
Chắc là các bạn sẽ nghĩ: Ôi, dễ ẹc, đã làm bằng tay được thì record macro sẽ có code --->Thì cứ thử đi rồi biết! (đố mà gán được công thức vào Label đấy!)
Tóm lại: Khi nào có code, cứ đưa lên đây để kiểm chứng
Ẹc... Ẹc...

Câu đố này hay quá, rất tiếc chưa thấy ai giải được, mình thì giải nhiều cách cũng chưa ra, không biết các cao thủ khác có cao kiến gì không?

Hoàng Trọng Nghĩa · 30/1/13

Em thử "từa lưa hột dưa" luôn vẫn không tài nào gán được công thức cho Label cả!

Ghi macro thì được, mà chạy macro thì vô phương!

Mã:

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 30/01/2013 by NRKH
'
    ActiveSheet.Shapes("Label 2").Select
    ExecuteExcel4Macro "FormulaR1C1(""=R1C1"")"
End Sub

Thôi, cũng mấy ngày rồi mà chưa ai có lời giải, Thầy giải luôn đi Thầy ơi, nóng lòng muốn biết kết quả quá!

ndu96081631 · 30/1/13

Hoàng Trọng Nghĩa đã viết:
Em thử "từa lưa hột dưa" luôn vẫn không tài nào gán được công thức cho Label cả!

Ghi macro thì được, mà chạy macro thì vô phương!

Mã:

Sub Macro2() ' ' Macro2 Macro ' Macro recorded 30/01/2013 by NRKH ' ActiveSheet.Shapes("Label 2").Select ExecuteExcel4Macro "FormulaR1C1(""=R1C1"")" End Sub

Thôi, cũng mấy ngày rồi mà chưa ai có lời giải, Thầy giải luôn đi Thầy ơi, nóng lòng muốn biết kết quả quá!

Dùng macro4 thì đúng rồi, có điều ăn tiền ở cách gán
Với macro của Nghĩa, sửa thành vầy sẽ được liền:

Mã:

Sub Macro2()
    ActiveSheet.Shapes("Label 2").Select
    ExecuteExcel4Macro [COLOR=#ff0000][B]"FORMULA(""=R1C1"")"[/B][/COLOR]
End Sub

Ẹc... Ẹc...
-----------------
Tặng luôn file viết code tổng quát

Mã:

Sub CreateLabel(ByVal Caption As String, ByVal FontName As String, _
                ByVal FontSize As Long, ByVal FontColor As Long)
  With ActiveCell
    .Value = Caption
    .Font.Name = FontName
    .Font.Size = FontSize
    .Font.ColorIndex = FontColor
    .EntireColumn.AutoFit
    .EntireRow.AutoFit
    .Parent.Labels.Add(.Left, .Top, .Width, .Height).Select
    ExecuteExcel4Macro "FORMULA(""=" & .Address(, , 2) & """)"
    ExecuteExcel4Macro "FORMULA("""")"
    .ClearContents
  End With
End Sub

Mã:

Sub Main()
  Dim Caption As String
  Caption = "Nguy" & ChrW(7877) & "n Anh Tu" & ChrW(7845) & "n"
  CreateLabel Caption, "Verdana", 20, 3
End Sub

VetMini · 30/1/13

Trong cái đề tài này:
Diễn đàn > Lập trình với Excel > Excel và các ngôn ngữ lập trình khác > Thư viện mã lập trình
> Useful functions - Các hàm hữu ích
Của levanduyet

Có đề cập tới
9) Hàm chuyển đổi số thứ tự cột thành chữ - Column number to Column letter

trong đó tác giả trích dẫn một đoạn code Convert the Excel Column Index to Letters như sau:

Mã:

Function ColumnLetter(ColumnNumber As Integer) As String
      
    '
    'example usage:
    '
    'Dim temp As Integer
    'temp = Sheets(1).Range("B2").End(xlToRight).Column
    'MsgBox "The last column of this region is " & _
    '        ColumnLetter(temp)
    '
        
If ColumnNumber <= 0 Then
    'negative column number
    ColumnLetter = ""
    
ElseIf ColumnNumber > 16384 Then
    'column not supported (too big) in Excel 2007
    ColumnLetter = ""
    
ElseIf ColumnNumber > 702 Then
    ' triple letter columns
    ColumnLetter = _
    Chr((Int((ColumnNumber-1-26-676) / 676)) Mod 676 + 65) & _
    Chr((Int((ColumnNumber-1-26) / 26) Mod 26) + 65) & _
    Chr(((ColumnNumber-1) Mod 26) + 65)

ElseIf ColumnNumber > 26 Then
    ' double letter columns
    ColumnLetter = Chr(Int((ColumnNumber-1) / 26) + 64) & _
            Chr(((ColumnNumber-1) Mod 26) + 65)
Else
    ' single letter columns
    ColumnLetter = Chr(ColumnNumber + 64)

End If

Vấn đề:
Đoạn code trên, chính tác giả đã nói rằng mình viết khởi đầu cho Excel 2003 (255 cột), sau đó nới thêm để ứng dụng cho 2007 (16384 cột).
Theo tôi thì đoạn code này được nới rộng một cách "làm cho xong". Nó không được gọn êm lắm. Xin mời các bạn viết lại cho đẹp.
Đương nhiên là cách trích từ address của cells(1, số) ra là gọn nhất. Giả sử không được dùng cách này.

(*) Xin lỗi đường đột. Tôi không biết làm như thế này có đúng tinh thần "đố vui" hay không. Nếu không đúng thì xin các bạn thứ lỗi.

Hoàng Trọng Nghĩa · 30/1/13

ndu96081631 đã viết:

Dùng macro4 thì đúng rồi, có điều ăn tiền ở cách gán
Với macro của Nghĩa, sửa thành vầy sẽ được liền:

Mã:

Sub Macro2()
    ActiveSheet.Shapes("Label 2").Select
    ExecuteExcel4Macro [COLOR=#ff0000][B]"FORMULA(""=R1C1"")"[/B][/COLOR]
End Sub

Ẹc... Ẹc...
-----------------
Tặng luôn file viết code tổng quát

Mã:

Sub CreateLabel(ByVal Caption As String, ByVal FontName As String, _
                ByVal FontSize As Long, ByVal FontColor As Long)
  With ActiveCell
    .Value = Caption
    .Font.Name = FontName
    .Font.Size = FontSize
    .Font.ColorIndex = FontColor
    .EntireColumn.AutoFit
    .EntireRow.AutoFit
    .Parent.Labels.Add(.Left, .Top, .Width, .Height).Select
    ExecuteExcel4Macro "FORMULA(""=" & .Address(, , 2) & """)"
    ExecuteExcel4Macro "FORMULA("""")"
    .ClearContents
  End With
End Sub

Mã:

Sub Main()
  Dim Caption As String
  Caption = "Nguy" & ChrW(7877) & "n Anh Tu" & ChrW(7845) & "n"
  CreateLabel Caption, "Verdana", 20, 3
End Sub

Sao kỳ thế Thầy, sao máy em, excel 2007 lại bấm nút file của Thầy chỉ nổi lên label rồi tên label xx thôi? không có gán được địa chỉ từ ô ?

ndu96081631 · 30/1/13

VetMini đã viết:
Đương nhiên là cách trích từ address của cells(1, số) ra là gọn nhất. Giả sử không được dùng cách này.

(*) Xin lỗi đường đột. Tôi không biết làm như thế này có đúng tinh thần "đố vui" hay không. Nếu không đúng thì xin các bạn thứ lỗi.

Chắc là vầy chăng:

Mã:

Function ColumnLetter(ByVal ColIndex As Long) As String
  If ColIndex <= 26 Then
    ColumnLetter = Chr(ColIndex + 64)
  Else
    ColumnLetter = ColumnLetter((ColIndex - 1) \ 26) & Chr(((ColIndex - 1) Mod 26) + 65)
  End If
End Function

Bạn test giúp!

ndu96081631 · 30/1/13

Hoàng Trọng Nghĩa đã viết:
Sao kỳ thế Thầy, sao máy em, excel 2007 lại bấm nút file của Thầy chỉ nổi lên label rồi tên label xx thôi? không có gán được địa chỉ từ ô ?

Thế còn đoạn code Macro 2 thì sao?

Hoàng Trọng Nghĩa · 30/1/13

ndu96081631 đã viết:
Thế còn đoạn code Macro 2 thì sao?

Có thể Thầy dùng Excel 2010 nên mới thực hiện điều đó chăng? Bởi quay macro nó cũng như Thầy sửa lại thôi, bởi em đã thử sửa cái chữ FORMULA thành FORMULAR1C1.

[video=youtube;pwwsYJCqHv0]http://www.youtube.com/watch?v=pwwsYJCqHv0&feature=youtu.be[/video]

anhtuan1066 · 26/2/13

Tạo mảng gồm các chuổi không trùng nhau

- Cho trước các ký tự: 0 đến 9, A đến Z
- Ghép lại thành 1 chuổi 5 ký tự (ví dụ: 0B1B9)
Hỏi: Viết code như thế nào để tạo ra 1000 chuổi như trên mà không có chuổi nào trùng nhau?

(Đố vui thì đương nhiên code sẽ rất đơn giản)

huuthang_bd · 26/2/13

anhtuan1066 đã viết:
- Cho trước các ký tự: 0 đến 9, A đến Z
- Ghép lại thành 1 chuổi 5 ký tự (ví dụ: 0B1B9)
Hỏi: Viết code như thế nào để tạo ra 1000 chuổi như trên mà không có chuổi nào trùng nhau?

View attachment 97587

(Đố vui thì đương nhiên code sẽ rất đơn giản)

Em thấy chữ cái xuất hiện trong kết quả của anh chỉ từ A-F thôi. Làm đại vầy không biết có đúng ý anh không.

PHP:

Function GetRandName()
Randomize
GetRangeName = Hex(Int(65536 * 15 * Rnd + 65536))
End Function

anhtuan1066 · 26/2/13

huuthang_bd đã viết:
Em thấy chữ cái xuất hiện trong kết quả của anh chỉ từ A-F thôi. Làm đại vầy không biết có đúng ý anh không.

PHP:

Function GetRandName() Randomize GetRangeName = Hex(Int(65536 * 15 * Rnd + 65536)) End Function

Cách này CHẤP NHẬN
Các bạn khác thử nghĩ giải pháp nào khác xem

VetMini · 26/2/13

ndu96081631 đã viết:
Chắc là vầy chăng:

Mã:

Function ColumnLetter(ByVal ColIndex As Long) As String If ColIndex <= 26 Then ColumnLetter = Chr(ColIndex + 64) Else ColumnLetter = ColumnLetter((ColIndex - 1) \ 26) & Chr(((ColIndex - 1) Mod 26) + 65) End If End Function

Bạn test giúp!

Chỉ khác tôi một chút xíu:

If ColIndex < 1 Then
ColumnLetter = ""

Đố vui về VBA!

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

Thành viên tích cực

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

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

Huyền thoại GPE

File đính kèm

Ăn cùng góc phố

Chuyên gia GPE

Huyền thoại GPE

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

Ăn cùng góc phố