Đố 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,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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
rollover79 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Lổi rất tinh vi... Cảm ơn bạn!
Vậy là giải quyết xong ngay... Một lổi duy nhất xuất hiện khi số lượng sheet = 1, vậy ta On Error Resume Next cho nó lẹ nhỉ?
PHP: 
Sub SelectMultiSheets()
  Dim Temp As String, i As Long
  On Error Resume Next
  i = ActiveSheet.Index
  Temp = " " & Join(Evaluate("Transpose(Row(1:" & Sheets.Count & "))"), " ") & " "
  Temp = Replace(Trim(Replace(Temp, " " & i & " ", " ")), " ", ",")
  Sheets(Evaluate("{" & Temp & "}")).Select
End Sub
Nhờ bạn test giúp!
-----------------
Lổi mà bạn phát hiện khiến tôi nhớ đến câu đố này của bạn:
http://www.giaiphapexcel.com/forum/showthread.php?t=20552
Hi... hi...
 
Lần chỉnh sửa cuối:
Upvote 0
Disable Auto_Open nhưng vẫn cho phép code khác chạy

File của tôi có 2 đoạn code thế này:
PHP: 
Sub Auto_Open()
   MsgBox "Hello! Auto Open"
End Sub
PHP: 
Sub Test()
  MsgBox "Hello! Test"
End Sub
- Giả sử Excel trên máy tôi đặt Security ở mức Medium
- Khi mở file, nếu tôi Disable macro thì chẳng code nào chạy được
Vậy nếu tôi chỉ muốn cấm riêng thằng em Auto_Open khi mở file mà vẫn cho phép Sub Test chạy thì phải làm thế nào?
 

File đính kèm

  • Book1.xls
    16.5 KB · Đọc: 21
Upvote 0
Gán phím tắt cho Private Sub

Trong sheet1 tôi có 1 sub sau:
PHP: 
Private Sub Test()
  MsgBox "Test 1"
End Sub
Trong sheet2 tôi cũng có 1 sub:
PHP: 
Private Sub Test()
  MsgBox "Test 2"
End Sub
Câu hỏi: Làm sau gán phím tắt cho 2 sub này
chẳng hạn:
Sub Test của sheet1 là Ctrl + Shift + A
Sub Test của sheet2 là Ctrl + Shift + S
 
Upvote 0
anhtuan1066 đã viết:
Trong sheet1 tôi có 1 sub sau:
PHP: 
Private Sub Test()
  MsgBox "Test 1"
End Sub
Trong sheet2 tôi cũng có 1 sub:
PHP: 
Private Sub Test()
  MsgBox "Test 2"
End Sub
Câu hỏi: Làm sau gán phím tắt cho 2 sub này
chẳng hạn:
Sub Test của sheet1 là Ctrl + Shift + A
Sub Test của sheet2 là Ctrl + Shift + S
Nhấp chuột vào đây để mở rộng...

Em tìm ra cách rồi nhưng vẫn không đi thẳng được, phải đi lòng vòng thôi!
Thân.
 

File đính kèm

  • VD.xls
    32.5 KB · Đọc: 25
Upvote 0
anhtuan1066 đã viết:
File của tôi có 2 đoạn code thế này:
PHP: 
Sub Auto_Open()
   MsgBox "Hello! Auto Open"
End Sub
PHP: 
Sub Test()
  MsgBox "Hello! Test"
End Sub
- Giả sử Excel trên máy tôi đặt Security ở mức Medium
- Khi mở file, nếu tôi Disable macro thì chẳng code nào chạy được
Vậy nếu tôi chỉ muốn cấm riêng thằng em Auto_Open khi mở file mà vẫn cho phép Sub Test chạy thì phải làm thế nào?
Nhấp chuột vào đây để mở rộng...
Cái này thì botay thật rồi! Không biết có mánh khoé gì không đây. Nếu không cho Auto_Open chạy thì thà khỏi ghi Open còn hơn. :=\+
Thân.
 
Upvote 0
Po_Pikachu đã viết:
Cái này thì botay thật rồi! Không biết có mánh khoé gì không đây. Nếu không cho Auto_Open chạy thì thà khỏi ghi Open còn hơn. :=\+
Thân.
Nhấp chuột vào đây để mở rộng...
Đôi lúc cũng cần Disable nó chứ
Giả định tình huống thế này:
- Người ta viết 1 chương trình, trong đó có Auto_Open để khi mở file là chương trình chạy luôn. Nhưng do chương trình đang trong giai đoạn hoàn thiện, người ta muốn test từng đoạn và không muốn cho Auto_Open chạy trước...
Người ta cũng không muốn disbale macro vì làm vậy sao test được các sub khác
Giải pháp: Bấm phím Shift trước khi double click vào file xls
---------------------------------
Câu đố gắn phím tắt cho Private Sub, bạn dùng Onkey là hoàn toàn chính xác (tôi không nghĩ ra có cách nào khác hơn)
(mà sao code thừa nhiều thế)
 
Lần chỉnh sửa cuối:
Upvote 0
anhtuan1066 đã viết:
Đôi lúc cũng cần Disable nó chứ
Giả định tình huống thế này:
- Người ta viết 1 chương trình, trong đó có Auto_Open để khi mở file là chương trình chạy luôn. Nhưng do chương trình đang trong giai đoạn hoàn thiện, người ta muốn test từng đoạn và không muốn cho Auto_Open chạy trước...
Người ta cũng không muốn disbale macro vì làm vậy sao test được các sub khác
Giải pháp: Bấm phím Shift trước khi double click vào file xls
---------------------------------
Câu đố gắn phím tắt cho Private Sub, bạn dùng Onkey là hoàn toàn chính xác (tôi không nghĩ ra có cách nào khác hơn)
(mà sao code thừa nhiều thế)
Nhấp chuột vào đây để mở rộng...
Code thừa để thực hiện chuyện khác mà! hihihi:D

Còn việc thực hiện lệnh trong giai đoạn viết code thì em chia nó ra theo mạng lưới sơ đồ trước. Rồi ghép code theo từng trường hợp vào -> Test bằng cách Pasue từng dòng -> Quét quy trình từng chu kỳ lệnh chạy. Giải quyết từng phân đoạn công việc. Chia thao tác ra nhiều phần -> Rồi cuối cùng tổng hợp chúng lại -> Test 1 vài lần cuối tổng số quy trình chạy cho tất cả -> Vậy là xong.
Không cần phải Disable-Enable gì cả? Toàn bộ quy trình viết code em chưa bao giờ phải dùng đến lệnh Disable Macro cả. Không biết bên bác viết code như thế nào mà cứ đóng mở hoài -> Mệt giữ vậy?! !$@!!
Thân.
 
Upvote 0
Po_Pikachu đã viết:
Không cần phải Disable-Enable gì cả? Toàn bộ quy trình viết code em chưa bao giờ phải dùng đến lệnh Disable Macro cả. Không biết bên bác viết code như thế nào mà cứ đóng mở hoài -> Mệt giữ vậy?! !$@!!
Thân.
Nhấp chuột vào đây để mở rộng...
Vấn đề ở đây là người ta ĐỐ VUI mà đồng chí?
Giải được câu đố mới là điều cần thiết trong topic này, còn việc ta có dùng nó hay không lại là 1 chuyện khác cơ mà!
Hic...
 
Upvote 0
Ẹc..Ẹcc...
Vậy bác có ý tưởng nào với việc này chưa?
Thân.
 
Upvote 0
Upvote 0
Tại sao phải dùng biến tạm trong code này

- Giả sử tôi có vùng dữ liệu liên tục từ A1 đến A30
- Tôi dùng công thức này:
=SUMPRODUCT(1/COUNTIF(A1:A30,A1:A30))
cho kết quả = 9
Tức có 9 phần tử duy nhất trong vùng A1:A30
​
- Tôi xây dựng 1 hàm để thay cho công thức trên như sau:
PHP: 
Function UniqueCount(SrcRng As Range) As Long
  Dim Clls As Range, Temp, Total
  Temp = WorksheetFunction.Transpose(SrcRng)
  For Each Clls In SrcRng
    If Clls <> "" Then
      Total = Total + 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1)
    End If
  Next
  UniqueCount = Total
End Function
- Tôi nhận xét thấy rằng đằng nào thì UniqueCount cũng chính là Total nên tôi sửa lại code thành:
PHP: 
Function UniqueCount(SrcRng As Range) As Long
  Dim Clls As Range, Temp
  Temp = WorksheetFunction.Transpose(SrcRng)
  For Each Clls In SrcRng
    If Clls <> "" Then
      UniqueCount = UniqueCount + 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1)
    End If
  Next
End Function
- Và kết quả sai bét
Xin hỏi: Tại sao bắt buộc phải dùng biến tạm thì kết quả mới đúng?
 

File đính kèm

  • UniqueCount.xls
    22.5 KB · Đọc: 27
Upvote 0
Mở rộng các vùng chọn không liên tục

Trước tiên các bạn hãy đọc bài viết này của sư phụ SA_DQ:
http://www.giaiphapexcel.com/forum/showpost.php?p=57155&postcount=13


ResizeSelect1.jpg



Trong đó sư phụ đã dùng vòng lập để "hợp" các vùng không liên tục thành một
Tôi có 1 câu hỏi cho các bạn: Có cách nào thực hiện được yêu cầu trên mà không cần vòng lập không?
Hi... Hi... Thú vị đây!
 
Upvote 0
anhtuan1066 đã viết:
Trước tiên các bạn hãy đọc bài viết này của sư phụ SA_DQ:
http://www.giaiphapexcel.com/forum/showpost.php?p=57155&postcount=13


ResizeSelect1.jpg



Trong đó sư phụ đã dùng vòng lập để "hợp" các vùng không liên tục thành một
Tôi có 1 câu hỏi cho các bạn: Có cách nào thực hiện được yêu cầu trên mà không cần vòng lập không?
Hi... Hi... Thú vị đây!
Nhấp chuột vào đây để mở rộng...
Xin góp vui 1 phương án.
Mã: 
Sub ExpandSelection()
    Dim rng As Range
    Set rng = Application.InputBox(prompt:="Select a NonContinueCells", Type:=8)
    Dim iTop As Integer, iLeft As Integer, iBottom As Integer, iRight As Integer
    
    iTop = Evaluate("MIN(ROW(" & Replace(Replace(rng.Address, ":", ","), ",", "),ROW(") & "))")
    iBottom = Evaluate("MAX(ROW(" & Replace(Replace(rng.Address, ":", ","), ",", "),ROW(") & "))")
    iLeft = Evaluate("MIN(COLUMN(" & Replace(Replace(rng.Address, ":", ","), ",", "),COLUMN(") & "))")
    iRight = Evaluate("MAX(COLUMN(" & Replace(Replace(rng.Address, ":", ","), ",", "),COLUMN(") & "))")
    
    Range(Cells(iTop, iLeft), Cells(iBottom, iRight)).Select
End Sub
 
Upvote 0
rollover79 đã viết:
Xin góp vui 1 phương án.
Mã: 
Sub ExpandSelection()
    Dim rng As Range
    Set rng = Application.InputBox(prompt:="Select a NonContinueCells", Type:=8)
    Dim iTop As Integer, iLeft As Integer, iBottom As Integer, iRight As Integer
 
    iTop = Evaluate("MIN(ROW(" & Replace(Replace(rng.Address, ":", ","), ",", "),ROW(") & "))")
    iBottom = Evaluate("MAX(ROW(" & Replace(Replace(rng.Address, ":", ","), ",", "),ROW(") & "))")
    iLeft = Evaluate("MIN(COLUMN(" & Replace(Replace(rng.Address, ":", ","), ",", "),COLUMN(") & "))")
    iRight = Evaluate("MAX(COLUMN(" & Replace(Replace(rng.Address, ":", ","), ",", "),COLUMN(") & "))")
 
    Range(Cells(iTop, iLeft), Cells(iBottom, iRight)).Select
End Sub
Nhấp chuột vào đây để mở rộng...
Rất xuất sắc! Thấy bạn tham gia mình mừng ghê, vì biết chắc sẽ học được thêm nhiều chiêu mới lạ
Còn mình thì tạm dùng cái này:
PHP: 
Sub BigRange()
  On Error GoTo Thoat
  With Application.InputBox("Chon vung", Type:=8)
    With Range(Replace(.Address, ",", ":"))
      MsgBox .Address
      .Select
    End With
  End With
Thoat:
End Sub
Hoặc UDF
PHP: 
Function GetBigRange(SrcRng As Range) As String
  GetBigRange = Range(Replace(SrcRng.Address, ",", ":")).Address
End Function
Mình thấy chỉ cần đổi dấu phẩy thành dấu hai chấm là được
Bạn kiểm tra lại giúp!
 

File đính kèm

  • TheBigRange_02.xls
    21.5 KB · Đọc: 32
Lần chỉnh sửa cuối:
Upvote 0
Bài toán về xử lý chuổi

Đầu năm, tôi có 1 bài toán khá thú vị xin gữi đến các bạn!
Trước tiên hãy xem qua topic này:
http://www.giaiphapexcel.com/forum/showthread.php?t=33787
Ở đây người ta muốn lấy các chữ cái đầu tiên của HỌ VÀ TÊN rồi ráp lại thành 1 text mới
Ví dụ:
- Ta có text NGUYỄN ANH TUẤN
- Sau khi qua các hàm xử lý chuổi sẽ cho kết quả = NAT
---------------
Bài này dùng vòng lập là cách mà xưa nay ta vẫn làm! Tôi muốn có cái gì đó gọi là "đột phá"... Vậy xin "thách đố" với các bạn rằng "Liệu có thể giải quyết bài toán trên mà không cần vòng lập không?"
Nếu thấy đây là đề tài thú vị, xin mời các cao thủ thử sức!
Hi... Hi...
 
Upvote 0
Trong bài tập: Tại sao phải dùng biến tạm Total vì nếu dùng UniqueCount thì sẽ trả trị về luôn!
If Clls <> "" Then
******************************************
UniqueCount = UniqueCount + 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1)
*********************************************
End If

 
Upvote 0
tbtduc đã viết:
Trong bài tập: Tại sao phải dùng biến tạm Total vì nếu dùng UniqueCount thì sẽ trả trị về luôn!
If Clls <> "" Then
******************************************
UniqueCount = UniqueCount + 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1)
*********************************************
End If
Nhấp chuột vào đây để mở rộng...
Không hiểu bạn nói gì!!!
Tuy nhiên, bạn đã quan tâm đến chủ đề, tôi xin giải đáp luôn. Lý do đơn giản là:
- Biểu thức 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1) chắc chắn sẽ là số thập phân
- Trong khi đó ta khai báo UniqueCount là biến Long nên mổi lần cộng dồn vào nó sẽ tự làm tròn luôn, đến cuối cùng sẽ cho kết quả sai
Tóm lại: sai là trong quá trình khai báo biến chứ không phải sai vì thuật toán
Để sửa lổi này ta có 2 cách:
- Một là dùng biến tạm và khai báo nó thuộc dạng Double
- Hai là ngay từ đầu ta khai báo hàm UniqueCount thuộc Double luôn
Thí nghiệm vầy sẽ thấy kết quả đúng:
PHP: 
Function UniqueCount(SrcRng As Range) As Double
  Dim Clls As Range, Temp
  Temp = WorksheetFunction.Transpose(SrcRng)
  For Each Clls In SrcRng
    If Clls <> "" Then
      UniqueCount = UniqueCount + 1 / (UBound(Filter(Temp, Clls.Value, 1)) + 1)
    End If
  Next
End Function
 
Upvote 0
Đảo ngược vị trí các từ trong 1 câu

Nếu ai giải quyết được bài #195 thì hãy tiếp tục với 1 bài gần tương tự (cấp độ khó hơn): ĐẢO NGƯỢC VỊ TRÍ CÁC TỪ TRONG 1 CÂU
Ví dụ:
- Cell A1 chứa chuổi Nguyễn Anh Tuấn
- Tôi muốn kết quả tại cell B1 là Tuấn Anh Nguyễn
Yêu cầu: Không dùng vòng lập
 
Upvote 0
anhtuan1066 đã viết:
Nếu ai giải quyết được bài #195 thì hãy tiếp tục với 1 bài gần tương tự (cấp độ khó hơn): ĐẢO NGƯỢC VỊ TRÍ CÁC TỪ TRONG 1 CÂU
Ví dụ:
- Cell A1 chứa chuổi Nguyễn Anh Tuấn
- Tôi muốn kết quả tại cell B1 là Tuấn Anh Nguyễn
Yêu cầu: Không dùng vòng lập
Nhấp chuột vào đây để mở rộng...

Mình giải 2 bài lần lượt bằng 2 hàm như sau, mình nhớ không nhầm thì hình như 2 bài này đã có đâu đó trên diễn đàn.

PHP: 
Function Fchrs(St As String) As String
    If InStr(St, " ") = 0 Then
        Fchrs = Left(St, 1)
    Else
        Fchrs = Left(St, 1) & Fchrs(Mid(St, InStr(St, " ") + 1))
    End If
End Function

Function StInv(St As String) As String
    If InStr(St, " ") = 0 Then
        StInv = " " & St
    Else
        StInv = Right(St, Len(St) - InStrRev(St, " ") + 1) & StInv(Left(St, InStrRev(St, " ") - 1))
    End If
End Function
 

File đính kèm

  • Book2.xls
    37.5 KB · Đọc: 16
Upvote 0
ptlong04x1 đã viết:
Mình giải 2 bài lần lượt bằng 2 hàm như sau, mình nhớ không nhầm thì hình như 2 bài này đã có đâu đó trên diễn đàn.

PHP: 
Function Fchrs(St As String) As String
If InStr(St, " ") = 0 Then
Fchrs = Left(St, 1)
Else
Fchrs = Left(St, 1) & Fchrs(Mid(St, InStr(St, " ") + 1))
End If
End Function
 
Function StInv(St As String) As String
If InStr(St, " ") = 0 Then
StInv = " " & St
Else
StInv = Right(St, Len(St) - InStrRev(St, " ") + 1) & StInv(Left(St, InStrRev(St, " ") - 1))
End If
End Function
Nhấp chuột vào đây để mở rộng...

Vâng! Bài toán này đã có trên diển đàn rồi, phần lớn đều dùng vòng lập!
Bạn dùng ĐỆ QUY cũng hay, nhưng về nguyên tắc nó cũng là LẬP
Yêu cầu của tôi là: Code thường, không LẬP bất cứ chổ nào cả... Hay nói chính xác hơn là KHÔNG CHẤP NHẬN GIẢI PHÁP ĐỆ QUY!
-------------
Gợi ý:
- Ta có trước chuổi NGUYỄN ANH TUẤN
- Hãy biến nó thành chuổi {"NGUYỄN";"ANH";"TUẤN"}
- Tiếp theo hãy dùng cách nào đó, gán chuổi này vào 1 biến và convert nó thành 1 MÃNG (dùng Evaluate...)
- Tiếp theo thì.... hãy để ý hàm LEFT dùng cho mãng (LEFT công thức Excel chứ không phải của VBA)...
- Trong bảng tính, nếu ta dùng công thức =LEFT({"NGUYỄN";"ANH";"TUẤN"},1) thì có phải kết quả nhận được là mảng {"N";"A";"T"} không?
- .....
- Cuối cùng là Join bọn nó lại
....
Hi... Hi...
Tiếp tục "thử sức" nhé!
 
Lần chỉnh sửa cuối:
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

thanhlanh
Muốn làm cho laptop yếu đi để cai nghiện game cho con?
    • Thích
2
Trả lời
35
Đọc
468
huhumalu
H
hung2412
  • Question
Có cách nào nạp một loạt giá trị Name (Name trong Name Manager) vào các Biến tương ứng trong VBA hay không?
2
Trả lời
22
Đọc
263
Mr.hieudoanxd
Mr.hieudoanxd
PHONGGANHHAO
Tinh tong cac o khong lien ke
    • Buồn
Trả lời
13
Đọc
164
VetMini
V
D
Xin giúp đỡ: Theo dõi hợp đồng lao động
    • Cười
Trả lời
3
Đọc
52
SA_DQ
SA_DQ
A
Nhờ giúp đỡ Công thức hàm dò tìm nhiều điều kiện
Trả lời
1
Đọc
25
thuytrangbp28
T
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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