Đố vui về VBA!

[anhtuan1066]

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:

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

 

[anhtuan1066]

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

  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

  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.

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ỉ?

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...

 

[anhtuan1066]

Disable Autpen 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:

Sub Auto_Open()
   MsgBox "Hello! Auto Open"
End Sub

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 Autpen khi mở file mà vẫn cho phép Sub Test chạy thì phải làm thế nào?

 

[anhtuan1066]

Gán phím tắt cho Private Sub

Trong sheet1 tôi có 1 sub sau:

Private Sub Test()
  MsgBox "Test 1"
End Sub

Trong sheet2 tôi cũng có 1 sub:

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

 

[Po_Pikachu]

Trong sheet1 tôi có 1 sub sau:

Private Sub Test()
  MsgBox "Test 1"
End Sub

Trong sheet2 tôi cũng có 1 sub:

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

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.

 

[Po_Pikachu]

File của tôi có 2 đoạn code thế này:

Sub Auto_Open()
   MsgBox "Hello! Auto Open"
End Sub

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 Autpen khi mở file mà vẫn cho phép Sub Test chạy thì phải làm thế nào?

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 Autpen chạy thì thà khỏi ghi Open còn hơn.
Thân.

 

[anhtuan1066]

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 Autpen chạy thì thà khỏi ghi Open còn hơn.
Thân.

Đô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ó Autpen để 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 Autpen 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ế)

 

[Po_Pikachu]

Đô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ó Autpen để 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 Autpen 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ế)

Code thừa để thực hiện chuyện khác mà! hihihi

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.

 

[ndu96081631]

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.

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...

 

[Po_Pikachu]

Ẹc..Ẹcc...
Vậy bác có ý tưởng nào với việc này chưa?
Thân.

 

[ndu96081631]

Ẹc..Ẹcc...
Vậy bác có ý tưởng nào với việc này chưa?
Thân.

Ở trên giải đáp rồi đấy thôi:

Giải pháp: Bấm phím Shift trước khi double click vào file xls

cái này chỉ cấm Autpen chứ không disable macro

 

[anhtuan1066]

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:

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:

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?

 

[anhtuan1066]

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

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!

 

[rollover79]

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

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!

Xin góp vui 1 phương án.

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

 

[anhtuan1066]

Xin góp vui 1 phương án.

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

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:

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

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!

 

[anhtuan1066]

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...

 

[tbtduc]

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

 

[anhtuan1066]

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

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:

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

 

[anhtuan1066]

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

 

[ptlong04x1]

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

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.

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

 

[anhtuan1066]

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.

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

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é!