Đố vui về VBA!

Liên hệ QC
anhtuan1066

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,911
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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!
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...
Em thay cái hàm LEN đó thành 1 con số thiệt là bự có được không anh Nghĩa?
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...

Vầy chắc được:
Mã: 
Sub Test()
  Dim txt As String
  txt = "Hoang Trong Nghia"
  MsgBox Mid(txt, 5)
End Sub
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...
Thử vầy coi sao. Chỉ 1 mà thôi đấy
PHP: 
Sub test()
Dim chuoi
chuoi = 123456789
MsgBox Replace(chuoi, "", "", 6)
End Sub
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...

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)
 
Upvote 0
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...
Nhấp chuột vào đây để mở rộng...

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?
 
Upvote 0
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á!
 
Upvote 0
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á!
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

  • Label_ChangeFont.xls
    30 KB · Đọc: 12
Upvote 0
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.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

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ừ ô ?
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...

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!
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Thế còn đoạn code Macro 2 thì sao?
Nhấp chuột vào đây để mở rộng...

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&amp;feature=youtu.be[/video]
 
Upvote 0
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?

Untitled.jpg





























(Đố vui thì đương nhiên code sẽ rất đơn giản)
 
Upvote 0
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)
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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!
Nhấp chuột vào đây để mở rộng...

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

If ColIndex < 1 Then
ColumnLetter = ""
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Kiều Mạnh
Lấy dữ liệu cổ phiếu từ Website Cafef.vn về Excel
    • Thích
3 4 5
Trả lời
84
Đọc
3K
YêuCN
Y
GPE-Trợ Lý
Đà Nẵng - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 05/10/2024
    • Thích
    • Yêu thích
Trả lời
15
Đọc
306
ptm0412
ptm0412
M
Không định dạng được dưới dạng Short Date
Trả lời
10
Đọc
144
ptm0412
ptm0412
M
Lọc dữ liệu nhiều điều kiện với nhiều kết quả trùng lặp
Trả lời
2
Đọc
74
ptm0412
ptm0412
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2
Trả lời
22
Đọc
1K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
U
VLOOKUP nhiều cột
    • Chấp nhận
Trả lời
16
Đọc
466
uronmapu
U
HeSanbi
  • Question
Hàm FilterA và FilterV - Tận dụng bộ lọc AutoFilter và AdvancedFilter
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
46
Đọc
3K
Manhhung90
Manhhung90
T
  • Question
viết code trong excel để sắp xếp theo yêu cầu sau đó tách sheet
Trả lời
0
Đọc
42
thufpts
T
Bạn Đoàn
Em Chào AC!. Em nhờ AC tạo UserForm nhập dữ giúp em với ạ.
    • Buồn
Trả lời
2
Đọc
59
SA_DQ
SA_DQ
T
  • Question
Tính tồn đầu , tồn cuối , nhập trong kỳ , xuất trong kỳ
Trả lời
12
Đọc
330
VetMini
V
chip07
Tách 1 dòng trong sheet thành 1 file riêng có thể cập nhật được
Trả lời
4
Đọc
94
VetMini
V
S
Hướng dẫn gán 1 biến workbook
Trả lời
14
Đọc
190
VetMini
V
D
Phân công và sắp xếp lịch trực
Trả lời
10
Đọc
287
HieuCD
H
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • Thích
35 36 37
Trả lời
736
Đọc
43K
SA_DQ
SA_DQ
PhanTuHuong
Các địa phương thiệt hại nặng nề do bão lũ 2024
    • Thích
2
Trả lời
23
Đọc
832
SA_DQ
SA_DQ
GPE-Trợ Lý
TP.HCM - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 06/10/2024
    • Thích
2
Trả lời
21
Đọc
1K
ptm0412
ptm0412
T
Hàm Sumifs nhiều điều kiện bị lỗi value hoặc trả về 0
Trả lời
14
Đọc
261
ptm0412
ptm0412
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
255
Đọc
24K
ngochienbmt
N
C
Công thức gộp 2 cột thành 1 (dữ liệu gộp so le)
Trả lời
10
Đọc
973
nguyenhuyen0805
N
H
  • Question
Lập trình số liệu Nhập-Xuất-Tồn
2
Trả lời
23
Đọc
463
HUONGHCKT
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom