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

anhtuan1066 · 30/12/07

Nhằm cũng cố kiến thức về VBA cho các bạn mới bắt đầu và cả những bạn đang ứng dụng mà chưa hiểu nhiều về nó, tôi mở topic này với mong mõi qua những câu hỏi vui, các bạn sẽ nhận định lại sự hiểu biết cũa mình... (Kễ cã chính tôi cũng đang tập tành nên có rất nhiều cái chưa biết)
Mong rằng topic sẽ mang đến cho các bạn những khám phá thú vị với những cái tưỡng chừng như đã biết
Mong nhận dc bài viết về câu đố cũa các cao thủ! Còn các bạn mới thì đừng ngại khi đưa ra ý kiến cũa mình.. Có sai có sữa sẽ hoàn thiện!
Tôi xin mỡ màn trước bằng 1 câu hỏi đơn giãn
ANH TUẤN

CÂU HỎI 1: Tại sao biến K ko hoạt động?
Tôi muốn khi nhấn vào 1 button thì cell A1 sẽ tăng lên 1 đơn vị... Tôi đã làm như sau:
-Tạo 1 Command Button (nút nhấn thuộc thanh Control Toolbox), click phải chuột lên nút nhấn, chọn View code, rồi gõ vào đoạn code sau:

PHP:

Private Sub CommandButton1_Click()
   K = K + 1
   Range("A1").Value = K
End Sub

Ban đầu K chưa có gì, xem như =0, nhấn nút lần thứ nhất thì K dc tăng thêm 1, vậy K hiện tại sẽ bằng 1, và gán K vào cell A1 thì đương nhiên A1 sẽ =1... Nhấn nút lần 2, K lại dc tăng thêm 1 nên hiện tại K sẽ =2 và cell A1 cũng sẽ =2... vân vân.. từ đó diễn tiến tiếp...
Hi.. hi.. Điều này nghe qua có vẽ rất hợp lý, ấy thế mà khi nhấn nút nó chỉ hoạt động dc duy nhất 1 lần (A1 = 1) rồi thôi ko nhút nhít nữa...
Các bạn có thể giãi thích tại sao lại như thế ko? Tại sao những lần nhấn nút sau đó K lại ko tăng thêm tí nào (vì thực tế A1 vẫn cứ = 1 hoài) ?
ANH TUẤN

anhtuan1066 · 4/3/09

Lâu quá không ghé thăm topic này. Hôm này mời các bạn xuất chiêu viết code cho tình huống như sau:
- Thông thường trong code, code nào viết trước sẽ dc thực hiện trước, code nào viết sau sẽ dc thực sau
Vậy nếu người ta yêu cầu:
- Thiết kế 1 bảng tính với 3 MsgBox
- Trong code, MsgBox thứ nhất nằm sau MsgBox thứ 2 và 3 (tức là viết code cho MsgBox thứ 2 và 3 trước... cả 3 MsgBox nằm chung 1 Sub)
Yêu cầu: Làm sao để khi chạy code thì MsgBox thứ nhất xuất hiện trước (rồi mới đến 2 MsgBox còn lại)
(Code càng ngắn càng tốt)
Tôi xin ví dụ code thế này:

PHP:

Sub MsgBox_Test()
  Dim Res As Long
  Res = MsgBox("Xin chon YES hoac NO", 4)
  If Res = 6 Then
    MsgBox "Ban da chon 'YES'"
  Else
    MsgBox "Ban da chon 'NO'"
  End If
End Sub

Bây giờ các bạn làm thế nào đưa MsgBox thứ nhất ra nằm sau 2 MsgBox còn lại (nhưng khi chạy code thì vẫn giống như ý đồ của code ví dụ trên)

rollover79 · 4/3/09

Chắc phải kèm theo điều kiện không dùng GoTo chứ, nếu dùng GoTo thì quá dễ.

Po_Pikachu · 4/3/09

Từ đó đến giờ em chỉ thấy code dạng này là chạy ngược thôi!

PHP:

Sub chay()
Application.InputBox("chon vung:", Type:=8).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Application.InputBox("chon o:", Type:=8), Unique:=True
End Sub

Không biết có đúng ý sư huynh không?
Thân.

anhtuan1066 · 4/3/09

Po_Pikachu đã viết:
Từ đó đến giờ em chỉ thấy code dạng này là chạy ngược thôi!

PHP:

Sub chay() Application.InputBox("chon vung:", Type:=8).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=Application.InputBox("chon o:", Type:=8), Unique:=True End Sub

Không biết có đúng ý sư huynh không?
Thân.

Mình đang hỏi về MsgBox cơ mà!

rollover79 đã viết:
Chắc phải kèm theo điều kiện không dùng GoTo chứ, nếu dùng GoTo thì quá dễ.

Mình viết bình thường thôi (đương nhiên cũng có tí xảo thuật) chứ ko GOTO gì cả

rollover79 · 4/3/09

Tiểu xảo thì thế này có được không nhỉ? Về bản chất vẫn cứ phải là tuần tự thôi.

Mã:

Sub test()
    Static l As Long
    If l = vbYes Then
        MsgBox "Yes"
    ElseIf l = vbNo Then
        MsgBox "No"
    Else
        l = MsgBox("Chon de", vbYesNo)
        Call test
    End If
End Sub

cadafi · 4/3/09

anh thử code này xem sao:

PHP:

Sub Check()
GoTo myCase
If a = vbYes Then MsgBox "Ban da chon [YES]" Else MsgBox "Ban da chon [NO]"
myCase: a = MsgBox("Xin chon [YES] hoac [NO]", 4)
End Sub

cadafi · 4/3/09

rollover79 đã viết:
Tiểu xảo thì thế này có được không nhỉ? Về bản chất vẫn cứ phải là tuần tự thôi.

Mã:

Sub test() Static l As Long If l = vbYes Then MsgBox "Yes" ElseIf l = vbNo Then MsgBox "No" Else l = MsgBox("Chon de", vbYesNo) Call test End If End Sub

Hehe! Code của anh chạy được có 1 lần à, chạy lại nó ra vui lắm!

ptm0412 · 4/3/09

Hehe! Code của anh chạy được có 1 lần à, chạy lại nó ra vui lắm!

Thêm câu lệnh này vào ngay trước End Sub:
l = 0

Hết vui!

rollover79 · 4/3/09

ca_dafi đã viết:
Hehe! Code của anh chạy được có 1 lần à, chạy lại nó ra vui lắm!

Muốn chạy nhiều lần thì dễ thôi mà. Liệu có phải chăng bác anhtuan1066 muốn nói tới là cái Static này chăng. Sửa lại thêm 2 dòng màu đỏ dưới này là OK thôi.

Mã:

Sub test()
    Static l As Long
    If l = vbYes Then
        MsgBox "Yes"
        [COLOR=Red]l = 0[/COLOR]
    ElseIf l = vbNo Then
        MsgBox "No"
        [COLOR=Red]l = 0[/COLOR]
    Else
        l = MsgBox("Chon de", vbYesNo)
        Call test
    End If
End Sub

Code của Ca_Di dùng tới GoTo mất rồi ...
To ptm: Không thêm trước End Sub được bác ạ.

ptm0412 · 4/3/09

To ptm: Không thêm trước End Sub được bác ạ.

Đựơc mà, mình test rồi. Về cơ bản thì Msg1 hoặc MSg2 hiện ra, nhấn OK đóng lại là thoát luôn ra ngoài If mà. Vậy câu lệnh đó đặt trong hay ngoài If cũng như nhau.

rollover79 · 4/3/09

ptm0412 đã viết:
Đựơc mà, mình test rồi. Về cơ bản thì Msg1 hoặc MSg2 hiện ra, nhấn OK đóng lại là thoát luôn ra ngoài If mà. Vậy câu lệnh đó đặt trong hay ngoài If cũng như nhau.

Chính xác, vì sau cái YesNo hiện ra thì Call lại hàm ngay nên không chạy đến End Sub...

ndu96081631 · 4/3/09

Giãi pháp của tôi là:

PHP:

Sub MsgBox_Test()
 MsgBox "Ban da chon " & Choose(1 - (MsgBox("Ban chon 'Yes' hay 'No'?", 4) = 6), "'No'", "'Yes'")
End Sub

Chưa kịp test ---> Các bạn test lại xem!

danchu · 4/3/09

chào các bạn!
mình là thành viên mới tham gia vào chương trình, mình rất thích tìm hiểu về VBA nhưng mới tìm hiểu nên còn mù tịt. Tham gia vào chương trình thấy nhiều cái mới và khó hiểu quá nên còn đang nghiên cứu các opic để bổ sung kiến thức.
theo mình nghĩ thì code bạn đưa lên thì cho k lặp rồi mới gán giá trị cho cell A1 nên nó không hiểu nên mình nghĩ là gán biến k vào giá trị A1 rồi mới cho biến lặp thì giá trị sẽ tăng
Private Sub CommandButton1_Click()
k = Range("A1").Value
k = k + 1
Range("A1").Value = k
End Sub
mình mới tập tọe thôi nhưng thấy code trên chạy được nên nêu ra ý kiến mong các bạn góp ý nhé.
- về đoạn code 2 theo mình hiểu bạn cho đoạn code vào modul nhằm tạo 1 code chung cho các sheet. khi viết code cho các sheet khác nhau thì chỉ cần goi ra không cần viết lại đoạn code chung đó mất thời gian (giống như ý kiến bạn COSNET.
mình mới tìm hiểu nên còn nhiều cái chưa hiểu biết, rất mong các bạn góp ý nhé.

anhtuan1066 · 4/3/09

ca_dafi đã viết:
anh thử code này xem sao:

PHP:

Sub Check() GoTo myCase If a = vbYes Then MsgBox "Ban da chon [YES]" Else MsgBox "Ban da chon [NO]" myCase: a = MsgBox("Xin chon [YES] hoac [NO]", 4) End Sub

Ko biết Kiệt có nhầm chổ nào ko? Sao code này nó chỉ xuất hiện có 1 cái MsgBox? Còn 2 cái nữa đâu? (có lẽ ngay từ đầu nó đã GOTO rồi)
Hi... hi...

anhtuan1066 · 12/4/09

Các bạn chạy thử đoạn code này:

PHP:

Sub Magic()
  Dim i As Long, Ch1 As String, Ch2 As String
  For i = 0 To 5
    Ch1 = Ch1 & Chr(i * (i * (i * (i * (-0.75 * i + 7.2917) - 22.5) + 16.708) + 28.25) + 72)
    Ch2 = Ch2 & Chr(i * (i * (i * (i * (i * (0.425 * i - 6.8667) + 40.833) - 109.58) + 122.24) - 23.05) + 87)
  Next i
  MsgBox Ch1 & Ch2
End Sub

Hãy nói cho mọi người biết:
1> Bạn thấy kết quả gì?
2> Tại sao lại thế?

anhtuan1066 · 23/5/09

Giả sử trong Sheet1, các cells từ A1 đến A20 chứa các giá trị: M001, M002, M003, M004 và M005 nhưng nằm lộn xộn (đại khái như hình dưới)

Lưu ý: Hình chỉ là minh họa, dử liêu thật có thể sắp xếp khác... Nói chung là TÙY THÍCH, miển sao A1:A20 chắc chắn có tồn tại 5 giá trị M001, M002, M003, M004 và M005
Tôi dùng 2 đoạn code sau đây:

PHP:

Sub Test1()
  With Range("A1:A20")
    MsgBox .Find("M004").Row
  End With
End Sub

Và

PHP:

Sub Test2()
  With Range("A1:A20")
    MsgBox WorksheetFunction.Match("M004", .Cells, 0)
  End With
End Sub

Theo các bạn 2 đoạn code trên có kết quả giống nhau hay khác nhau? Tại sao?

Minh Nguyen · 29/5/09

Chào bác anhtuan,
Khi chạy như thế này thì cùng trả kết quả là số dòng của M004.
Ý nghĩa lệnh Find và hàm Match thì bác biết rồi.
Tuy nhiên, nếu em thay M004 thành M004xx thì lại khác nhau hoàn toàn.

Cái này thì vẫn ra kết quả như cũ, vì mình ẩn đi tùy chọn tìm kiếm là xlPart.

PHP:

Sub Test1()
  With Range("A1:A20")
    MsgBox .Find("M004").Row
  End With
End Sub

Cái này thì báo lỗi, vì hàm MATCH không thể tìm thấy cell nào có giá trị giống hệt M004 nữa.

PHP:

Sub Test2()
  With Range("A1:A20")
    MsgBox WorksheetFunction.Match("M004", .Cells, 0)
  End With
End Sub

Nếu em có gì sai thì bác chỉnh lại nhé |||||

anhtuan1066 · 29/5/09

Minh Nguyen đã viết:
Chào bác anhtuan,
Khi chạy như thế này thì cùng trả kết quả là số dòng của M004.
Ý nghĩa lệnh Find và hàm Match thì bác biết rồi.
Tuy nhiên, nếu em thay M004 thành M004xx thì lại khác nhau hoàn toàn.

Cái này thì vẫn ra kết quả như cũ, vì mình ẩn đi tùy chọn tìm kiếm là xlPart.

PHP:

Sub Test1() With Range("A1:A20") MsgBox .Find("M004").Row End With End Sub

Cái này thì báo lỗi, vì hàm MATCH không thể tìm thấy cell nào có giá trị giống hệt M004 nữa.

PHP:

Sub Test2() With Range("A1:A20") MsgBox WorksheetFunction.Match("M004", .Cells, 0) End With End Sub

Nếu em có gì sai thì bác chỉnh lại nhé

Đưa câu hỏi lên hổm nay mà chẳng thấy ai hỏi han gì đến, cũng buồn...
May có người hỏi: Mừng quá!
Chúng ta đang tìm "M004"... vậy bạn thử thay cell A1 thành M004 rồi chạy 2 code xem nó thế nào? Từ đó suy ra kết luận
Ỳ tôi muốn nói đến trường hợp dử liệu cần tìm nằm ngay cell đầu tiên ấy
Và trong trường này Find làm việc ra sao?
He.. he..

Minh Nguyen · 29/5/09

Em hiểu ý bác rồi, hihi
Cái thằng Find nó có tùy chọn After đúng không ạ ? Mình mà để mặc định thì nó bỏ qua the first cell bác nhỉ. Thảo nào trong trường hợp của bác thì kết quả lệnh Find và hàm Match là khác nhau.
Phải không bác nhỉ ?

Minh Nguyen · 29/5/09

anhtuan1066 đã viết:
Các bạn chạy thử đoạn code này:

PHP:

Sub Magic() Dim i As Long, Ch1 As String, Ch2 As String For i = 0 To 5 Ch1 = Ch1 & Chr(i * (i * (i * (i * (-0.75 * i + 7.2917) - 22.5) + 16.708) + 28.25) + 72) Ch2 = Ch2 & Chr(i * (i * (i * (i * (i * (0.425 * i - 6.8667) + 40.833) - 109.58) + 122.24) - 23.05) + 87) Next i MsgBox Ch1 & Ch2 End Sub

Hãy nói cho mọi người biết:
1> Bạn thấy kết quả gì?
2> Tại sao lại thế?

Cái này của bác là hàm Chr(charcode), nó sẽ trả về kí tự tương ứng theo bảng mã ASCII. Công thức của bác phức tạp quá nhưng em biết nó ra tập hợp là "Hello World!"

ChanhTQ@ · 29/5/09

Nó làm việc như thế này, còn tại sao thì chắc phải hỏi ngài BG thôi!

Ỳ tôi muốn nói đến trường hợp dử liệu cần tìm nằm ngay cell đầu tiên ấy
Và trong trường này Find làm việc ra sao?

Mình lập vùng dữ liệu sau:

A | B TN=TN/1.000 |
TN <6|0
TN <34|(TN-6)*150
TN <80|(34-6)*150 + (TN-34)*300
TN <150|4.200 + (80-34)*300+ (TN - 80)*400
150<TN|18.000 + (150-80)* 400 + (TN-150)* 45

Và cho chạy macro sau:

PHP:

Option Explicit
Sub FindFirst()
Dim Srng As Range, Rng As Range
Dim MyAdd As String, StrC As String
 
Set Rng = Range("A1:A20")
 
Set Srng = Rng.Find("TN", , xlFormulas, xlPart)
If Not Srng Is Nothing Then
    MyAdd = Srng.Address
    Do
        StrC = StrC & Srng.Address & " "
7       Set Srng = Rng.FindNext(Srng)
    Loop While Not Srng Is Nothing And Srng.Address <> MyAdd
    MsgBox Srng.Address, , StrC
End If
End Sub

Kết quả trên nút chữ OK là hai dòng sau:
$A$2 $A$3 $A$4 $A$5 $A$6 $A$1
$A$2

Còn nếu thay dòng lệnh 7 thành

Mã:

Set Srng = Rng.FindPrevious(Srng)

thì kết quả như sau
$A$2 $A$1 $A$6 $A$5 $A$4 $A$3
$A$2

Kiểu này giống như: Sinh con rồi mới sinh cha, sinh cháu giữ nhà rồi mới sinh ông.

anhtuan1066 · 30/5/09

Minh Nguyen đã viết:
Cái này của bác là hàm Chr(charcode), nó sẽ trả về kí tự tương ứng theo bảng mã ASCII. Công thức của bác phức tạp quá nhưng em biết nó ra tập hợp là "Hello World!"

Bạn có thể thí nghiệm bằng công thức như sau:
- Từ cell A2 đến A7, gõ lần lượt các số từ 0 đến 5
- Tại B2, gõ công thức:

PHP:

=B1&CHAR(ROUND((A2 * (A2 * (A2 * (A2 * (-0.75 * A2 + 7.2917) - 22.5) + 16.708) + 28.25) + 72),0))

kéo fill xuống đến B7
- Tại cell C2, gõ công thức:

PHP:

=C1&CHAR(ROUND((A2 * (A2 * (A2 * (A2 * (A2 * (0.425 * A2 - 6.8667) + 40.833) - 109.58) + 122.24) - 23.05) + 87),0))

Kéo fill xuống đến C7
- Tại cell D7, gõ công thức: =B7&C7 ===> Và đây là kết quả cuối cùng
Đây chỉ là trò đùa vui thôi! Hi.. hi..

anhtuan1066 · 8/7/09

Consolidate có tổng hợp được dử liệu bài này không?

Hãy xem dử liệu tôi đang có:

Vùng màu vàng tôi dùng SUMIF để tính tổng... Các bạn hãy thử xem nếu bài này tôi làm bằng Consolidate (Hoặc Find method) thì có ra kết quả hay không?

anhtuan1066 · 17/10/09

Tôi có 1 câu hỏi mời các bạn tham khảo!
Giả sử có đoạn code như sau:

PHP:

Sub Test()
  Dim i As Long
  With Range("A:A")
    For i = 1 To 10
      .Cells(i) = i
      MsgBox .SpecialCells(4).Areas(1)(1).Address
    Next i
  End With
End Sub

Vấn đề là: Các bạn chạy code này ngay trong file đính kém dưới đây của tôi thì không có vấn đề, nhưng nếu các bạn copy code cho vào 1 file mới thì code lại báo lổi
???
Tại sao lại thế? --=0

concogia · 17/10/09

anhtuan1066 đã viết:
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

Mình thuộc loại gà mờ VBA nhưng rất thích và đang học, theo mình biến K là biến thông thương nên phải khai báo K như sau: STATIC K AS INTEGER. Hổng biết đúng hông nữa

TranThanhPhong · 17/10/09

anhtuan1066 đã viết:
Tôi có 1 câu hỏi mời các bạn tham khảo!
Giả sử có đoạn code như sau:

PHP:

Sub Test() Dim i As Long With Range("A:A") For i = 1 To 10 .Cells(i) = i MsgBox .SpecialCells(4).Areas(1)(1).Address Next i End With End Sub

Vấn đề là: Các bạn chạy code này ngay trong file đính kém dưới đây của tôi thì không có vấn đề, nhưng nếu các bạn copy code cho vào 1 file mới thì code lại báo lổi
???
Tại sao lại thế?

Anh Tuấn nghĩ ra mấy cái này vui thật!

Vào PB xem sẽ thấy?

Thanh Phong

anhtuan1066 · 17/10/09

ttphong2007 đã viết:
Anh Tuấn nghỉ ra mấy cái này vui thật!

Vào PB xem sẽ thấy?

Thanh Phong

Phong ơi mình chưa hiểu lắm. PB là cái gì vậy?

TranThanhPhong · 17/10/09

anhtuan1066 đã viết:
Phong ơi mình chưa hiểu lắm. PB là cái gì vậy?

Vào Page Break sẽ thấy Area (1)(1). Ô 999 có 1 space.

TTP

anhtuan1066 · 17/10/09

ttphong2007 đã viết:
Vào Page Break sẽ thấy Area (1)(1). Ô 999 có 1 space.

TTP

Thế này nhé:
- Phong chọn toàn bộ bảng tính, vào menu Edit\Clear\All
- Thế là chẳng còn cell nào rổng
Giờ chạy lại code xem, nó cũng đâu báo lổi gì
??? Hi... hi...

TranThanhPhong · 17/10/09

anhtuan1066 đã viết:
Thế này nhé:
- Phong chọn toàn bộ bảng tính, vào menu Edit\Clear\All
- Thế là chẳng còn cell nào rổng
Giờ chạy lại code xem, nó cũng đâu báo lổi gì
??? Hi... hi...

Anh làm như anh nói save file lại rồi mở file ra và chạy lại xem thế nào

!

TTP

loveforht87 · 17/10/09

tedaynui đã viết:
Em cũng tham gia tí :
Anh muốn biến K tăng thì Anh cần khai báo biến Public. Ví dụ :

PHP:

Public K As Integer Private Sub CommandButton1_Click() K = K + 1 Range("A1").Value = K End Sub

hoặc anh dùng cách sau (có khác đôi chút)

PHP:

Private Sub CommandButton1_Click() Range("A1").Value = Range("A1").Value + 1 End Sub

TDN
</span></span>

Sao mình làm cách 1 không được, báo lỗi, còn cách 2 thì được. Lạ nhỉ?

anhtuan1066 · 17/10/09

ttphong2007 đã viết:
Anh làm như anh nói save file lại rồi mở file ra và chạy lại xem thế nào !

TTP

Ah.. vâng! Chổ tôi cần hỏi là chổ này đây!
Tại sao nó.. lại thế mới là vấn đề chứ?
Vậy chúng ta hiểu SpecialCells(xlCellTypeBlanks) chính xác là như thế nào đây?

Po_Pikachu · 17/10/09

Em nghĩ rằng cái SpecialCells(xlCellTypeBlanks) là vùng trống (của file đang lưu trên RAM) tính từ lúc bác chỉnh sữa dữ liệu trên file (hay nói cách khác là từ lúc mở file đến trước lúc lưu mới [Save; Save As]) đến trước khi lưu file lại. Vậy có ổn không?
Thân.

solomon2211 · 17/10/09

Public K As Integer
Private Sub CommandButton1_Click()
K = K + 1
Range("A1").Value = K
End Sub

Private Sub CommandButton1_Click()
Range("A1").Value = Range("A1").Value + 1
End Sub

loveforht87 đã viết:
Sao mình làm cách 1 không được, báo lỗi, còn cách 2 thì được. Lạ nhỉ?

Cách 1 báo lỗi vì ngay từ lúc đầu, K bằng bao nhiêu làm sao biết được, nên K+1 sẽ không có kết quả.

anhtuan1066 · 17/10/09

Po_Pikachu đã viết:
Em nghĩ rằng cái SpecialCells(xlCellTypeBlanks) là vùng trống (của file đang lưu trên RAM) tính từ lúc bác chỉnh sữa dữ liệu trên file (hay nói cách khác là từ lúc mở file đến trước lúc lưu mới [Save; Save As]) đến trước khi lưu file lại. Vậy có ổn không?
Thân.

Tôi không dám chắc việc này, nhưng các bạn hãy cùng tôi làm 1 thí nghiệm nhé
- Xóa rổng cột A rồi chọn toàn bộ cột A này, bấm Ctrl + G\Special\Blanks: Excel báo lổi
- Xóa rổng cột A, gõ gì đó vào A1 rồi chọn toàn bộ cột A, bấm Ctrl + G\Special\Blanks: Excel vẫn báo lổi
- - Xóa rổng cột A, gõ gì đó vào A2 rồi chọn toàn bộ cột A, bấm Ctrl + G\Special\Blanks: Hết lổi
------------------------
Lưu ý quan trọng: Kể từ khi Excel hết báo lổi thì dù ta có làm gì (chẳng hạn lập lại các thao tác trên) nó cũng vẫn không còn báo lổi nữa
Sao lại thế chứ?

ptlong04x1 · 17/10/09

solomon2211 đã viết:
Cách 1 báo lỗi vì ngay từ lúc đầu, K bằng bao nhiêu làm sao biết được, nên K+1 sẽ không có kết quả.

Không phải bạn ạ, biến Public K kiểu integer sau khi khai báo sẽ có giá trị mặc định là 0 chứ, mình thử code 1 hoàn toàn bình thường, bạn trên làm không được chắc là do nhập code sai chỗ nào rồi.

Po_Pikachu · 17/10/09

anhtuan1066 đã viết:
Tôi không dám chắc việc này, nhưng các bạn hãy cùng tôi làm 1 thí nghiệm nhé
{B1}- Xóa rổng cột A rồi chọn toàn bộ cột A này, bấm Ctrl + G\Special\Blanks: Excel báo lổi
{B2}- Xóa rổng cột A, gõ gì đó vào A1 rồi chọn toàn bộ cột A, bấm Ctrl + G\Special\Blanks: Excel vẫn báo lổi
{B3}- Xóa rổng cột A, gõ gì đó vào A2 rồi chọn toàn bộ cột A, bấm Ctrl + G\Special\Blanks: Hết lổi
------------------------
Lưu ý quan trọng: Kể từ khi Excel hết báo lổi thì dù ta có làm gì (chẳng hạn lập lại các thao tác trên) nó cũng vẫn không còn báo lổi nữa
Sao lại thế chứ?

Bác làm các thao tác này liên tục trên 1 bảng tính thì tất nhiên nó phải vậy rồi. Vì ở {B1} và {B2} nó làm gì có ô rỗng. Rồi vào {B3} thì xuất hiện ô rỗng A1. Vậy là xong rồi.
Bác thử làm 3 bước này ở 3 bảng tính hoàn toàn mới xem. Có thể bỏ qua việc "Xóa rổng cột A" đi, vì bảng tính mới thì làm gì có dữ liệu đâu mà xóa chứ.

Mã:

[U]TH1:[/U]
[I]Mở bảng tính mới, nhập dữ liệu A1, rồi bấm[/I] [B]Ctrl + G\Special\Blanks[/B]: [B][I][COLOR=#ff0000]Excel báo lổi[/COLOR][/I][/B]

Mã:

[COLOR=#ff0000][I][COLOR=black][U]TH2:[/U][/COLOR][/I]
[I][COLOR=black]Mở bảng tính mới, nhập dữ liệu A2, rồi bấm [B]Ctrl + G\Special\Blanks: [/B][/COLOR][B][COLOR=red][I]Excel báo ô A1[/I][/COLOR][/B][/I][/COLOR]

Mã:

[/COLOR]
[COLOR=#ff0000][I][COLOR=black][U]TH3:[/U][/COLOR][/I]
[I][COLOR=black]Mở bảng tính mới, nhập dữ liệu A2, rồi xóa nó đi, rồi bấm [B]Ctrl + G\Special\Blanks: [/B][/COLOR][B][COLOR=red][I]Excel báo ô A1 và A2[/I][/COLOR][/B][/I][/COLOR]

Thậm chí bác có xóa luôn cột A ở TH3 thì Excel vẫn báo [A1:A2] rổng à. Vậy bác nghĩ sao về điều này?
Thân.

huuthang_bd · 17/10/09

Thử với code này xem. Dù có thao tác thế nào. Khi xóa hết dữ liệu rồi chạy code này cũng sẽ báo lỗi.

PHP:

Sub Text()
ActiveSheet.UsedRange.Select
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Select
End Sub

Theo tôi, SpecialCells(xlCellTypeBlanks) là những cell rỗng trong vùng bảng tính từ cell A1 đến Cell cuối cùng đã sử dụng. Bạn đã nhập liệu vào một cell nào đó, cho dù bạn có xóa nó đi thì cell đó vẫn được tính là cell đã sử dụng rồi. Nhưng khi đóng file hoặc sử dụng thuộc tính UsedRange thì cell cuối cùng đã sử dụng sẽ được xác định lại. Chỉ những cell thực sự được sử dụng mới tính là cell đã sử dụng.

anhtuan1066 · 18/10/09

huuthang_bd đã viết:
Thử với code này xem. Dù có thao tác thế nào. Khi xóa hết dữ liệu rồi chạy code này cũng sẽ báo lỗi.

PHP:

Sub Text() ActiveSheet.UsedRange.Select ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Select End Sub

Theo tôi, SpecialCells(xlCellTypeBlanks) là những cell rỗng trong vùng bảng tính từ cell A1 đến Cell cuối cùng đã sử dụng. Bạn đã nhập liệu vào một cell nào đó, cho dù bạn có xóa nó đi thì cell đó vẫn được tính là cell đã sử dụng rồi. Nhưng khi đóng file hoặc sử dụng thuộc tính UsedRange thì cell cuối cùng đã sử dụng sẽ được xác định lại. Chỉ những cell thực sự được sử dụng mới tính là cell đã sử dụng.

Vâng! Chính xác là thế này:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks)
tương đương với
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)
và
Range("... gì gì đó... ").SpecialCells(xlCellTypeBlanks)
tương đương với
Intersect(ActiveSheet.UsedRange,Range("... gì gì đó... ")).SpecialCells(xlCellTypeBlanks)
Chỉ thế thôi
Và các bạn khi dùng SpecialCells(4) phải hết sức cẩn thận về điều này

TrungChinhs · 18/10/09

anhtuan1066 đã viết:
Vâng! Chính xác là thế này:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks)
tương đương với
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)
và
Range("... gì gì đó... ").SpecialCells(xlCellTypeBlanks)
tương đương với
Intersect(ActiveSheet.UsedRange,Range("... gì gì đó... ")).SpecialCells(xlCellTypeBlanks)
Chỉ thế thôi
Và các bạn khi dùng SpecialCells(4) phải hết sức cẩn thận về điều này

Cảm ơn anhtuan1066! Tôi hay sử dụng SpecialCells(4) nhưng hôm nay mới biết điều này. Những thông tin từ bạn thật là hữu ích.

huuthang_bd · 18/10/09

anhtuan1066 đã viết:
Vâng! Chính xác là thế này:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks)
tương đương với
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)
và
Range("... gì gì đó... ").SpecialCells(xlCellTypeBlanks)
tương đương với
Intersect(ActiveSheet.UsedRange,Range("... gì gì đó... ")).SpecialCells(xlCellTypeBlanks)
Chỉ thế thôi
Và các bạn khi dùng SpecialCells(4) phải hết sức cẩn thận về điều này

Cái này thì không đúng. Có thể kiểm tra bằng thí nghiệm này:
Mở một file mới
Gõ gì đó vào ô B5
Gõ gì đó vào ô C10
Lần lượt chạy 2 đoạn code sau:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Select

ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select
Kết quả sẽ khác nhau

anhtuan1066 · 18/10/09

huuthang_bd đã viết:
Cái này thì không đúng. Có thể kiểm tra bằng thí nghiệm này:
Mở một file mới
Gõ gì đó vào ô B5
Gõ gì đó vào ô C10
Lần lượt chạy 2 đoạn code sau:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks).Select

ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select
Kết quả sẽ khác nhau

Sorry! Sơ xuất
Chính xác là:
ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks)
tương đương với

Range(ActiveSheet.UsedRange, [A1]).SpecialCells(xlCellTypeBlanks)

anhtuan1066 · 24/10/09

Chuyển từng ký tự của 1 chuổi vào 1 mãng

Giả sữ tôi có 1 chuổi gồm các ký tự AlphaB (ký tự không dấu). Tôi muốn chuyển từng ký tự trong chuổi này vào 1 mãng, thông thường người ta làm như sau:

PHP:

Function StringToArray(Text As String)
  Dim i As Long, Temp
  ReDim Temp(1 To Len(Text))
  For i = 1 To Len(Text)
    Temp(i) = Mid(Text, i, 1)
  Next
  StringToArray = Temp
End Function

Sử dụng hàm này như sau:
- Ví dụ cell A1 chứa chuối "ABCD"
- Quét chọn 4 cell nằm cùng 1 dòng (chẳng hạn B1:E1) rồi gõ vào thanh Formula công thưc =StringToArray(A1) sau đó bấm tổ hợp phím Ctrl + Shift + Enter
-------------
Xin hỏi mọi người: Liệu ta có thể xây dựng code đáp ứng nhu cầu như trên mà không cần dùng vòng lập hay không?
Ý tưởng xuất hiện khi đọc bài này:
http://www.giaiphapexcel.com/forum/showthread.php?t=6499
Hi... hi... Hãy "cày" thử... Thú vị đấy

rollover79 · 26/10/09

anhtuan1066 đã viết:
Giả sữ tôi có 1 chuổi gồm các ký tự AlphaB (ký tự không dấu). Tôi muốn chuyển từng ký tự trong chuổi này vào 1 mãng, thông thường người ta làm như sau:

PHP:

Function StringToArray(Text As String) Dim i As Long, Temp ReDim Temp(1 To Len(Text)) For i = 1 To Len(Text) Temp(i) = Mid(Text, i, 1) Next StringToArray = Temp End Function

Sử dụng hàm này như sau:
- Ví dụ cell A1 chứa chuối "ABCD"
- Quét chọn 4 cell nằm cùng 1 dòng (chẳng hạn B1:E1) rồi gõ vào thanh Formula công thưc =StringToArray(A1) sau đó bấm tổ hợp phím Ctrl + Shift + Enter
-------------
Xin hỏi mọi người: Liệu ta có thể xây dựng code đáp ứng nhu cầu như trên mà không cần dùng vòng lập hay không?
Ý tưởng xuất hiện khi đọc bài này:
http://www.giaiphapexcel.com/forum/showthread.php?t=6499
Hi... hi... Hãy "cày" thử... Thú vị đấy

Dữ kiện đầu bài có đoạn màu xanh hơi "nghi ngờ", nhưng nếu chỉ có điều kiện không chơi vòng lặp thì như này là ăn tiền ...

ptm0412 · 26/10/09

nhưng nếu chỉ có điều kiện không chơi vòng lặp thì như này là ăn tiền

Một dạng của đệ quy!
Bản chất của đệ quy cũng là lặp, gọi chạy lại nguyên hàm. Chỉ khác là không phải dùng For Next hoặc Do Loop thôi. Phải không RollOver?

rollover79 · 26/10/09

ptm0412 đã viết:
Một dạng của đệ quy!
Bản chất của đệ quy cũng là lặp, gọi chạy lại nguyên hàm. Chỉ khác là không phải dùng For Next hoặc Do Loop thôi. Phải không RollOver?

Gần như vậy, nhưng bản chất không hẳn là đệ quy. Vấn để ko rõ ý tác giả là không dùng câu lệnh lặp hay bản chất là không lặp, chính vì vậy tôi mới nói là nếu chỉ có điều kiện không chơi vòng lặp là ăn tiền, vì đâu có tìm được vòng lặp trong hàm đâu

.

anhtuan1066 · 27/10/09

rollover79 đã viết:
Dữ kiện đầu bài có đoạn màu xanh hơi "nghi ngờ", nhưng nếu chỉ có điều kiện không chơi vòng lặp thì như này là ăn tiền ...

Cảm ơn bạn vì cách giải rất hay (mình học được rất nhiều từ bạn)
Mình thì làm thế này:

PHP:

Function StringToArray(Text As String)
  StringToArray = Split(StrConv(Text, 64), Chr(0))
End Function

Cái dòng màu xanh mà bạn nói "nghi ngờ" ấy là vì mình vẫn ko tài nào dùng cách này áp dụng cho tiếng Việt có dấu (nên phải hạn chế điều kiện)

concogia · 27/10/09

anhtuan1066 đã viết:
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

khai báo biến K:
static K á integer

sealand · 27/10/09

Xin lỗi các bạn, mình có ý kiến như 1 người khán thính như thế này:

1/Phương pháp của Anh Tuan 1066 mình cho là hay và chắc chắn tốc độ, chiếm dụng tài nguyên ít hơn.
2/Hàm của rollover79 thì mình cho rằng chỉ mới thoát được mệnh đề điều khiển lặp thôi, con thực chất vẫn là vòng lặp. Thậm chí, mỗi vòng lặp thì chạy hàm 1 lần và hàm mới trả về 1 phần tử của mảng mà thôi.

rollover79 · 27/10/09

sealand đã viết:
Xin lỗi các bạn, mình có ý kiến như 1 người khán thính như thế này:

1/Phương pháp của Anh Tuan 1066 mình cho là hay và chắc chắn tốc độ, chiếm dụng tài nguyên ít hơn.
2/Hàm của rollover79 thì mình cho rằng chỉ mới thoát được mệnh đề điều khiển lặp thôi, con thực chất vẫn là vòng lặp. Thậm chí, mỗi vòng lặp thì chạy hàm 1 lần và hàm mới trả về 1 phần tử của mảng mà thôi.

Tiêu đề của Topic là "Đố vui ...", nên điều quan trọng nhất vẫn là tìm ra lời giải thì mới vui

. Còn vấn đề hiệu quả(tốc độ, chiếm dụng tài nguyên) thì còn phải bàn và test thêm. Cái đáng học hỏi ở đây là cái hàm StrConv, bạn thử xem xem hàm này nó có tác dụng gì, tác dụng chính của nó ko phải là để phục vụ cho việc split như đang đề cập, và nó còn có nhiều tính năng nữa, vậy chắc gì hiệu quả trong trường hợp này của nó đã tối ưu???

anhtuan1066 · 28/10/09

rollover79 đã viết:
Tiêu đề của Topic là "Đố vui ...", nên điều quan trọng nhất vẫn là tìm ra lời giải thì mới vui . Còn vấn đề hiệu quả(tốc độ, chiếm dụng tài nguyên) thì còn phải bàn và test thêm. Cái đáng học hỏi ở đây là cái hàm StrConv, bạn thử xem xem hàm này nó có tác dụng gì, tác dụng chính của nó ko phải là để phục vụ cho việc split như đang đề cập, và nó còn có nhiều tính năng nữa, vậy chắc gì hiệu quả trong trường hợp này của nó đã tối ưu???

Thú thật là tôi cũng chưa hoàn toàn thấu đáo về hàm này... Phát hiện dc chút chút nên đưa lên để góp vui
Nếu có thời gian rảnh rỗi mong bạn rollover79 nói thêm về hàm này (cảm ơn bạn trước)
----------------------------------
Bây giờ xin gữi thêm 1 câu hỏi vui cho các bạn
Nếu:
- Tôi có trước 1 chuổi tại cell A1 (là chữ Tuan chẳng hạn)
- Tôi có 1 biến A được gán giá trị bằng lệnh A = Range("A1").Value
Thì:
- Tôi có thể nhìn thấy được kết quả gì sau câu lệnh này MsgBox A(0)

sealand · 28/10/09

1/Mình muốn thêm 1 chút về giải pháp của Anh Tuan 1066 câu đố kỳ trước đúng là Rollover 79 nhận xét xác đáng. Anh Tuan đã chamj đích nhứng không dấn lên để đạt trọn vẹn. Tự thân hàm StrConv đã có khả năng tạo mảng rồi nên thừa hàm Split. Hơn nữa, kể cả là có dấu tiếng Việt cũng OK. Bạn xem thử nhé:

Mã:

[COLOR=Blue]Sub TestArr()
Dim A() As Byte
A = StrConv("HµNéi", 128)[/COLOR]
[COLOR=MediumTurquoise]'Kiem tra ket qua[/COLOR]
[COLOR=Blue]For i = 0 To UBound(A)
MsgBox Chr(A(i))
Next
End Sub[/COLOR]

1/Mình muốn hỏi thêm:

Ta có chuỗi str1= "ADSSUYTHNBM"
Trong code có câu lệnh: Msgbox tb

Mình muốn gán biến tb = ký tự thứ 5 của chuỗi bằng hàm String2Array() của Rollove 79 thì viết lệnh thế nào?

anhtuan1066 · 28/10/09

sealand đã viết:
1/Mình muốn thêm 1 chút về giải pháp của Anh Tuan 1066 câu đố kỳ trước đúng là Rollover 79 nhận xét xác đáng. Anh Tuan đã chamj đích nhứng không dấn lên để đạt trọn vẹn. Tự thân hàm StrConv đã có khả năng tạo mảng rồi nên thừa hàm Split. Hơn nữa, kể cả là có dấu tiếng Việt cũng OK. Bạn xem thử nhé:

Mã:

[COLOR=blue]Sub TestArr()[/COLOR] [COLOR=blue]Dim A() As Byte[/COLOR] [COLOR=blue]A = StrConv("HµNéi", 128)[/COLOR] [COLOR=mediumturquoise]'Kiem tra ket qua[/COLOR] [COLOR=blue]For i = 0 To UBound(A)[/COLOR] [COLOR=blue]MsgBox Chr(A(i))[/COLOR] [COLOR=blue]Next[/COLOR] [COLOR=blue]End Sub[/COLOR]

Anh ơi em vẫn chưa hiểu lắm, anh có thể viết code vào 1 file ví dụ được không (thành 1 UDF ấy)... Vì em đã thử với tham số 128 rồi nhưng chưa đạt kết quả mong muốn với chuổi tiếng Việt Unicode

sealand đã viết:
1/Mình muốn hỏi thêm:
Ta có chuỗi str1= "ADSSUYTHNBM"
Trong code có câu lệnh: Msgbox tb
Mình muốn gán biến tb = ký tự thứ 5 của chuỗi bằng hàm String2Array() của Rollove 79 thì viết lệnh thế nào?

Anh có thể nói rõ 1 tí về yêu cầu này không?

sealand · 28/10/09

Trong VBA thì Code hay hàm đều bó tay với Unicode tiếng Việt có dấu vì không các xác định được code của ký tự, hàm StrConv() cũng không là ngoại lệ. Nhưng mình test với TCVN3 thì được.
Mình gửi file ví dụ kèm

Mình nói thêm về cú pháp hàm String2Array() của Rollove 79. Nếu hàm này cho ta 1 mảng thì ta có phải khai báo mảng trung gian để chứa kết quả rồi mới lấy phần tử từ mảng này không?

anhtuan1066 · 28/10/09

sealand đã viết:
Trong VBA thì Code hay hàm đều bó tay với Unicode tiếng Việt có dấu vì không các xác định được code của ký tự, hàm StrConv() cũng không là ngoại lệ. Nhưng mình test với TCVN3 thì được.
Mình gửi file ví dụ kèm

Mình nói thêm về cú pháp hàm String2Array() của Rollove 79. Nếu hàm này cho ta 1 mảng thì ta có phải khai báo mảng trung gian để chứa kết quả rồi mới lấy phần tử từ mảng này không?

Dùng là hàm này "chơi" được với TCVN3...

PHP:

Function TextArr(ch As String)
  TextArr = Split(StrConv(ch, 64), Chr(0))
End Function

ndu96081631 · 29/10/09

Ẹc... Ẹc...
Sao anh Sealand có thể THANKS được 2 nhát thế nhỉ?

-----------------
Code trên chỉ chạy được với font TCVN3... Em biết vấn đề nằm ở đâu rồi... Vì TCVN3 là font 1 Byte, còn tiếng Việt Unicode là 2 Byte ---> Có thể dùng câu đố tại bài #151 để kiểm tra

anhtuan1066 · 17/11/09

Select nhiều sheet cùng 1 lúc mà không dùng vòng lập

Giả sử tôi có 1 file Excel chứa 10 sheet, trong đó có 1 sheet tên là Dulieu
Các bạn hãy dùng code thế nào để có thể chọn cùng lúc 9 sheet (trừ sheet Dulieu ra) mà không cần dùng đến vòng lập
Code nguyên gốc dùng vòng lập như sau:

PHP:

Sub SelectMultiSheets()
  Dim Sh As Worksheet, Check As Boolean
  Check = True
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "Dulieu" Then Sh.Select Check: Check = False
  Next
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Các bạn hãy cải tiến bỏ vòng lập nhé

Hai Lúa Miền Tây · 17/11/09

anhtuan1066 đã viết:
Giả sử tôi có 1 file Excel chứa 10 sheet, trong đó có 1 sheet tên là Dulieu
Các bạn hãy dùng code thế nào để có thể chọn cùng lúc 9 sheet (trừ sheet Dulieu ra) mà không cần dùng đến vòng lập
Code nguyên gốc dùng vòng lập như sau:

PHP:

Sub SelectMultiSheets() Dim Sh As Worksheet, Check As Boolean Check = True For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> "Dulieu" Then Sh.Select Check: Check = False Next MsgBox ActiveWindow.SelectedSheets.Count End Sub

Các bạn hãy cải tiến bỏ vòng lập nhé

Mình dùng Array được không Thầy ? +-+-+-+

khoavu87 · 17/11/09

anhtuan1066 đã viết:
Giả sử tôi có 1 file Excel chứa 10 sheet, trong đó có 1 sheet tên là Dulieu
Các bạn hãy dùng code thế nào để có thể chọn cùng lúc 9 sheet (trừ sheet Dulieu ra) mà không cần dùng đến vòng lập
Code nguyên gốc dùng vòng lập như sau:

PHP:

Sub SelectMultiSheets() Dim Sh As Worksheet, Check As Boolean Check = True For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> "Dulieu" Then Sh.Select Check: Check = False Next MsgBox ActiveWindow.SelectedSheets.Count End Sub

Các bạn hãy cải tiến bỏ vòng lập nhé

cái này có thể tận dụng chức năng "Group" của excel ko Anh ơi.Hic a ra bài nào cũng độc đáo thật

anhtuan1066 · 17/11/09

domfootwear đã viết:
Mình dùng Array được không Thầy ?

khoavu87 đã viết:
cái này có thể tận dụng chức năng "Group" của excel ko Anh

Bất cứ kiểu gì các bạn cảm thấy thích hợp, miển không dùng vòng lập và code... HAY
Hi... hi...
Ra tay thử đi bạn ơi! (cho vui nhà vui cửa)

Hai Lúa Miền Tây · 17/11/09

anhtuan1066 đã viết:
Bất cứ kiểu gì các bạn cảm thấy thích hợp, miển không dùng vòng lập và code... HAY
Hi... hi...
Ra tay thử đi bạn ơi! (cho vui nhà vui cửa)

Nghĩ mãi không ra code hay thầy à.
Không dùng dòng lặp thì còn nước là qui định sheet trong mãn mà select thôi thầy à. +-+-+-+

anhtuan1066 · 17/11/09

domfootwear đã viết:
Nghĩ mãi không ra code hay thầy à.
Không dùng dòng lặp thì còn nước là qui định sheet trong mãn mà select thôi thầy à.

Gợi ý:
Giả sử ta dời sheet Dulieu đến vị trí đầu tiên (nằm bên trái), sau đo record macro quá trình chọn từ sheet2 đến sheet cuối, ta sẽ được code đại khái như sau:

PHP:

Sub Macro1()
  Sheets(Array("Sheet2", "Sheet3", "Sheet4")).Select
  Sheets("Sheet3").Activate
End Sub

Code này có thể sửa lại:

PHP:

Sub Macro1()
  Sheets(Array(2, 3, 4)).Select
End Sub

Gần ra rồi đấy!
Việc của bạn bây giờ là "định" 1 Array có giá trị từ 2 đến Sheets.Count.. sau đó ráp vào

PHP:

Sub SelectMultiSheets()
  Dim Temp
  Temp = ... gì gì đó
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Đương nhiên Temp là 1 Array, có giá trị = {2,3,4,..... ,Sheets.Count}
Đại khái thế... Cố xem!
Hi... hi...

ngocmaipretty · 17/11/09

Đương nhiên Temp là 1 Array, có giá trị = {2,3,4,..... ,Sheets.Count}

Hì, chắc lại xài create object gì đó chứ gì, ngocmai không biết VBA nhưng đoán vậy, vì là độc chiêu của anhtuan&ndu mừ.

anhtuan1066 · 17/11/09

ngocmaipretty đã viết:
Hì, chắc lại xài create object gì đó chứ gì, ngocmai không biết VBA nhưng đoán vậy, vì là độc chiêu của anhtuan&ndu mừ.

Ah... không phức tạp thế đâu... Một Array bình thường như ta vẫn thường làm khi tạo name động ấy (gần gần giống với công thức ROW(INDIRECT("1:"&...... )
Không hề khó đâu!

sealand · 17/11/09

Để có thể giải quyết gọn hơn mình muốn tham khảo các bạn 1 chút:
-Để chọn sheet1 ta dùng lệnh Sheet1.Select
-Khi ta bỏ chọn 1 sheet ta dùng lệnh gì?

Nếu giải đáp được thì vấn đề đơn giản hơn nhiều: Ta chọn toàn bộ sheet bằng lệnh ThisWorkbook.Sheets.Select.
Sau đó ta bỏ chọn sheet theo yêu cầu là xong.

anhtuan1066 · 17/11/09

sealand đã viết:
Để có thể giải quyết gọn hơn mình muốn tham khảo các bạn 1 chút:
-Để chọn sheet1 ta dùng lệnh Sheet1.Select
-Khi ta bỏ chọn 1 sheet ta dùng lệnh gì?

Nếu giải đáp được thì vấn đề đơn giản hơn nhiều: Ta chọn toàn bộ sheet bằng lệnh ThisWorkbook.Sheets.Select.
Sau đó ta bỏ chọn sheet theo yêu cầu là xong.

Không được anh à! cách này không khả thi
Vì khi toàn bộ sheet đã được Select (tức chúng đã nằm chung 1 Group) mọi tác động cố gắng tách 1 sheet ra khỏi Group cũng đều làm cho Group ấy bị "rã đám" ngay!
Em gợi ý theo cách em đã nói ở trên:
- Tạo 1 biến ="ROW(2:" & Sheets.Count & ")"
- Xử lý biến này thêm vài "chiêu" nữa cho nó biến thành Array là xong!
Thực chất hoàn toàn khả thì, vì khi dùng name động ta vẫn thường làm theo kiểu này (ROW(INDIRECT("1:"&..... )

sealand · 17/11/09

Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon()
    Sheets("Data").Move Before:=Sheets(1)
    Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _
    Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select
    End Sub

Hai Lúa Miền Tây · 17/11/09

sealand đã viết:
Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon() Sheets("Data").Move Before:=Sheets(1) Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _ Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select End Sub

Cái này cũng giống như sau:

Mã:

Sub SelectMultiSheets()
  Dim Temp
  Temp = Array(2, 3, 4, 5, 6, 7, 8, 9, 10)
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Em đã thử rồi, như em đã nói ở trên, cách này là cách thủ công, chọn từng sheet anh à, cái khó là chọn tất cả các sheet bằng 1 câu nào đó trừ sheet "Dulieu" ra. +-+-+-+

anhtuan1066 · 17/11/09

sealand đã viết:
Nếu thế mình thấy chỉ còn cách này:

Mã:

Sub Chon() Sheets("Data").Move Before:=Sheets(1) Sheets(Array(Sheets(2).Name, Sheets(3).Name, Sheets(4).Name, Sheets(5).Name, _ Sheets(6).Name, Sheets(7).Name, Sheets(8).Name, Sheets(9).Name, Sheets(10).Name)).Select End Sub

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

domfootwear đã viết:
Cái này cũng giống như sau:

Mã:

Sub SelectMultiSheets() Dim Temp Temp = Array(2, 3, 4, 5, 6, 7, 8, 9, 10) Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Temp).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Em đã thử rồi, như em đã nói ở trên, cách này là cách thủ công, chọn từng sheet anh à, cái khó là chọn tất cả các sheet bằng 1 câu nào đó trừ sheet "Dulieu" ra.

Vâng! Cũng gần như thế
Vấn đề là ta đâu có biết trước Workbook gồm bao nhiêu sheet? (đề bài cho 10 sheet chỉ là giả lập thôi)
------------
Thôi, làm luôn

PHP:

Sub SelectMultiSheets()
  Dim Temp
  Temp = Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Temp).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

Hoặc ngắn gọn, khỏi cần biến luôn

PHP:

Sub SelectMultiSheets()
  Sheets("Dulieu").Move Before:=Sheets(1)
  Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select
  MsgBox ActiveWindow.SelectedSheets.Count
End Sub

sealand · 17/11/09

AnhTuan dùng Evaluate quá hay. Đây là cách định trị không cần dùng vòng lặp để set. AnhTuan đã đề cập về hàm này của VBA (Không phải Macro4) trong 1 bài gần đây (Hình như bài sử dụng hàm Ad-In trong VBA thì phải), nhưng thực lòng mình không nghĩ ra.
Xin lỗi, mình cố tình "chọc" để AnhTuan giải đáp nhé, chứ câu lệnh của mình khỏi cần Move chi hết mà trực tiếp chỉ đầu từng "thằng" rôi.

anhtuan1066 · 18/11/09

sealand đã viết:
Xin lỗi, mình cố tình "chọc" để AnhTuan giải đáp nhé, chứ câu lệnh của mình khỏi cần Move chi hết mà trực tiếp chỉ đầu từng "thằng" rôi.

Vâng! Đây cũng chính là yêu cầu của câu đố tiếp theo!
Nội dung:
- Với một Workbook chứa nhiều sheet, hãy dùng code để Select toàn bộ các sheet (ngoại trừ sheet hiện hành) mà không dùng đến vòng lập
Yêu cầu phụ:
- Không được di chuyển bất cứ sheet nào ra khỏi vị trí hiện tại của nó
----------------------
Câu hỏi này gần giống với bài #157 nhưng ở cấp độ khó hơn rất nhiều... Mời các cao thủ thử sức (giải thuật đã có, tin rằng các bạn sẽ làm được)

rollover79 · 18/11/09

anhtuan1066 đã viết:
-----------------------

Vâng! Cũng gần như thế
Vấn đề là ta đâu có biết trước Workbook gồm bao nhiêu sheet? (đề bài cho 10 sheet chỉ là giả lập thôi)
------------
Thôi, làm luôn

PHP:

Sub SelectMultiSheets() Dim Temp Temp = Evaluate("Transpose(ROW(2:" & Sheets.Count & "))") Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Temp).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Hoặc ngắn gọn, khỏi cần biến luôn

PHP:

Sub SelectMultiSheets() Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

Code này cần phải có thêm 1 điều kiện là tất cả các sheet phải đang ở trạng thái hiển thị, nếu có 1 sheet nào đang ở trạng thái ẩn là có vấn đề ngay. Nếu chỉ khử "câu lệnh vòng lặp" thì có thể dùng đến thủ thuật để gọi lại hàm tương tự như đệ quy để khử, phương pháp này thực chất vẫn là lặp nhưng không sử dụng câu lệnh vòng lặp, và có thể xử lý tất cả các trường hợp như sheet ẩn, không di chuyển sheet ...

anhtuan1066 · 18/11/09

rollover79 đã viết:
Code này cần phải có thêm 1 điều kiện là tất cả các sheet phải đang ở trạng thái hiển thị, nếu có 1 sheet nào đang ở trạng thái ẩn là có vấn đề ngay. Nếu chỉ khử "câu lệnh vòng lặp" thì có thể dùng đến thủ thuật để gọi lại hàm tương tự như đệ quy để khử, phương pháp này thực chất vẫn là lặp nhưng không sử dụng câu lệnh vòng lặp, và có thể xử lý tất cả các trường hợp như sheet ẩn, không di chuyển sheet ...

Vâng! Cảm ơn những góp ý của bạn!
Ở đây mình chỉ "tập dợt" về thuật toán, chia sẽ những kiến thức tình cờ phát hiện ra (mà ta cho là hay và lạ)
Vậy ta thống nhất với nhau thế này nhé: Trong Workbook không có sheet ẩn nào
ĐỆ QUY rất hay (mình vẫn đang học) nhưng ở đây mình cũng xin loại trừ phương pháp này, vì thực chất nó vẫn là LẬP
Cứ dựa trên cơ sơ này mà làm, nếu có điều kiện ta sẽ nâng cấp độ khó lên (như bạn vừa nói)
Mến
ANH TUẤN

rollover79 · 18/11/09

anhtuan1066 đã viết:
Vâng! Cảm ơn những góp ý của bạn!
Ở đây mình chỉ "tập dợt" về thuật toán, chia sẽ những kiến thức tình cờ phát hiện ra (mà ta cho là hay và lạ)
Vậy ta thống nhất với nhau thế này nhé: Trong Workbook không có sheet ẩn nào
ĐỆ QUY rất hay (mình vẫn đang học) nhưng ở đây mình cũng xin loại trừ phương pháp này, vì thực chất nó vẫn là LẬP
Cứ dựa trên cơ sơ này mà làm, nếu có điều kiện ta sẽ nâng cấp độ khó lên (như bạn vừa nói)
Mến
ANH TUẤN

Vậy nhân tiện xin hỏi bác luôn là điều kiện không di chuyển bất cứ sheet nào ra khỏi vị trí của nó là trong toàn bộ quá trình chạy các sheet vẫn phải yên vị ở đúng vị trí đó hay có thể di chuyển nhưng cuối cùng phải đưa nó về vị trí như ban đầu?

anhtuan1066 · 18/11/09

rollover79 đã viết:
Vậy nhân tiện xin hỏi bác luôn là điều kiện không di chuyển bất cứ sheet nào ra khỏi vị trí của nó là trong toàn bộ quá trình chạy các sheet vẫn phải yên vị ở đúng vị trí đó hay có thể di chuyển nhưng cuối cùng phải đưa nó về vị trí như ban đầu?

Bạn muốn làm thế nào tùy thích, miễn sao kết thúc quá trình thì mọi thứ vẫn được đặt đúng ví trí (như ban đầu)
Đương nhiên sẽ ưu tiên cho giải pháp KHÔNG DỊCH CHUYỂN SHEET trong quá trình chạy code!
Cảm ơn bạn đã quan tâm đến topic này... (Cao thủ nhúng tay vào chắc có nhiều điều để học hỏi đây)

rollover79 · 18/11/09

anhtuan1066 đã viết:
Bạn muốn làm thế nào tùy thích, miễn sao kết thúc quá trình thì mọi thứ vẫn được đặt đúng ví trí (như ban đầu)
Đương nhiên sẽ ưu tiên cho giải pháp KHÔNG DỊCH CHUYỂN SHEET trong quá trình chạy code!
Cảm ơn bạn đã quan tâm đến topic này... (Cao thủ nhúng tay vào chắc có nhiều điều để học hỏi đây)

Bác nói quá rồi, chẳng qua thấy bác sưu tầm được nhiều bài toán hay hay nên cũng muốn thử chút. Tôi thử 2 phương pháp, chủ yếu vẫn dựa vào ý tưởng trên.
Phương án có di chuyển sheet trong quá trình chạy(giữ nguyên đoạn giữa của bác):

Mã:

Sub SelectMultiSheets()
    Dim i As Integer
    i = Sheets("Dulieu").Index
    '--------------------------------------------------------------
    Sheets("Dulieu").Move Before:=Sheets(1)
    Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select
    MsgBox ActiveWindow.SelectedSheets.Count
    '--------------------------------------------------------------
    Dim sh
    Set sh = ActiveWindow.SelectedSheets
    Sheets("Dulieu").Move after:=Sheets(i)
    sh.Select
End Sub

Phương án không di chuyển sheet trong quá trình chạy:

Mã:

Sub SelectMultiSheets()
    Sheets(Evaluate("Transpose(ROW(1:" & Sheets.Count - 1 & ")+IF(ROW(1:" & Sheets.Count - 1 & ")>=" & Sheets("Dulieu").Index & ",1,0))")).Select
    MsgBox ActiveWindow.SelectedSheets.Count
End Sub

-----
Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

anhtuan1066 · 18/11/09

rollover79 đã viết:
Bác nói quá rồi, chẳng qua thấy bác sưu tầm được nhiều bài toán hay hay nên cũng muốn thử chút. Tôi thử 2 phương pháp, chủ yếu vẫn dựa vào ý tưởng trên.
Phương án có di chuyển sheet trong quá trình chạy(giữ nguyên đoạn giữa của bác):

Mã:

Sub SelectMultiSheets() Dim i As Integer i = Sheets("Dulieu").Index '-------------------------------------------------------------- Sheets("Dulieu").Move Before:=Sheets(1) Sheets(Evaluate("Transpose(ROW(2:" & Sheets.Count & "))")).Select MsgBox ActiveWindow.SelectedSheets.Count '-------------------------------------------------------------- Dim sh Set sh = ActiveWindow.SelectedSheets Sheets("Dulieu").Move after:=Sheets(i) sh.Select End Sub

Phương án không di chuyển sheet trong quá trình chạy:

Mã:

Sub SelectMultiSheets() Sheets(Evaluate("Transpose(ROW(1:" & Sheets.Count - 1 & ")+IF(ROW(1:" & Sheets.Count - 1 & ")>=" & Sheets("Dulieu").Index & ",1,0))")).Select MsgBox ActiveWindow.SelectedSheets.Count End Sub

-----
Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

Vẫn có chổ đáng đề học đấy bạn chứ... Chiêu hay trong này theo tôi là
Set sh = ActiveWindow.SelectedSheets
Công nhân là rất khéo léo
Đoạn code thứ 2 cũng rất ngắn gọn và tinh tế
Mình xin đưa lên giải pháp "củ chuổi" này (nói rằng củ chuối là vì phải thông qua việc xử lý chuổi)

PHP:

Sub SelectMultiSheets()
  Dim Temp As String, i As Long
  i = ActiveSheet.Index
  Temp = Join(Evaluate("Transpose(Row(1:" & Sheets.Count & "))"), ",")
  Temp = Replace(Replace(Temp, "," & i, ""), i & ",", "")
  Sheets(Evaluate("{" & Temp & "}")).Select
End Sub

Xin bạn góp ý thêm
Cảm ơn!
---------------------

Có lẽ nên thêm 1 điều kiện nữa là Workbook phải có tối thiếu 2 Sheet, nếu chỉ có 1 Sheet Dulieu thì cần phải thêm phần kiểm tra trước khi chạy!

Nhấp chuột vào đây để mở rộng...

Ah... xin nói thêm: Chuyện này tôi đã lường trước và code chạy tốt cho dù cho bao nhiều sheet (bạn test giúp)

vũ trung kiên · 18/11/09

Đối với đoạn code trên chỉ là vd đơn giản nên có thể làm trực tiếp hoặc thông qua lệnh Call gọi hàm Add.
Một người lập trình chuyên nghiệp là phải lập trình theo gói như cách thứ 2 gọi hàm add

ndu96081631 · 18/11/09

vũ trung kiên đã viết:
Đối với đoạn code trên chỉ là vd đơn giản nên có thể làm trực tiếp hoặc thông qua lệnh Call gọi hàm Add.
Một người lập trình chuyên nghiệp là phải lập trình theo gói như cách thứ 2 gọi hàm add

Bạn vui lòng nói rõ hơn 1 chút được không? (có ví dụ minh họa càng tốt)
Tay ngang như tôi nghe bạn nói vậy cũng bằng không... vì chẳng hiểu gì cả!
Cảm ơn trước nhé!

rollover79 · 18/11/09

anhtuan1066 đã viết:
Vẫn có chổ đáng đề học đấy bạn chứ... Chiêu hay trong này theo tôi là
Set sh = ActiveWindow.SelectedSheets
Công nhân là rất khéo léo
Đoạn code thứ 2 cũng rất ngắn gọn và tinh tế
Mình xin đưa lên giải pháp "củ chuổi" này (nói rằng củ chuối là vì phải thông qua việc xử lý chuổi)

PHP:

Sub SelectMultiSheets() Dim Temp As String, i As Long i = ActiveSheet.Index Temp = Join(Evaluate("Transpose(Row(1:" & Sheets.Count & "))"), ",") Temp = Replace(Replace(Temp, "," & i, ""), i & ",", "") Sheets(Evaluate("{" & Temp & "}")).Select End Sub

Xin bạn góp ý thêm
Cảm ơn!
---------------------

Ah... xin nói thêm: Chuyện này tôi đã lường trước và code chạy tốt cho dù cho bao nhiều sheet (bạn test giúp)

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.

anhtuan1066 · 19/11/09

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.

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

anhtuan1066 · 4/12/09

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:

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

anhtuan1066 · 5/1/10

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

Po_Pikachu · 5/1/10

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

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 · 5/1/10

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

pen chạy thì thà khỏi ghi Open còn hơn. $:=\+$
Thân.

anhtuan1066 · 5/1/10

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 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ó Aut

pen để 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 Aut

pen 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 · 6/1/10

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ó 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 · 6/1/10

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.

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 · 6/1/10

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

ndu96081631 · 6/1/10

Po_Pikachu đã viết:
Ẹ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:

anhtuan1066 đã viết:
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 Aut

pen chứ không disable macro

anhtuan1066 · 16/1/10

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?

anhtuan1066 · 26/1/10

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 · 26/1/10

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

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.

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

anhtuan1066 · 26/1/10

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

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!

anhtuan1066 · 19/2/10

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 · 19/2/10

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 · 19/2/10

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

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

anhtuan1066 · 21/2/10

Đả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 · 21/2/10

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

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

anhtuan1066 · 21/2/10

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

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

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

Người dùng đang xem chủ đề này

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

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

Thành viên tiêu biểu

Po_pikachu@ymail.com

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

Thành viên tiêu biểu

Hành động từ trái tim

Hành động từ trái tim

Bad Excel Member

Thành viên tiêu biểu

Bad Excel Member

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên mới

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

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

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

File đính kèm

Thành viên mới

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

Thành viên mới

Thành viên mới

0901452không62

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

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

File đính kèm

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

File đính kèm

Gội rồi mới Cạo

Ngày mai trời lại sáng!

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

Ngày mai trời lại sáng!

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

Ngày mai trời lại sáng!

Thành viên mới

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

Po_pikachu@ymail.com

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

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

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

Po_pikachu@ymail.com

Chuyên gia GPE

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

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

Chuyên gia GPE

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

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

Thành viên tiêu biểu

File đính kèm

Bad Excel Member

Thành viên tiêu biểu

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

File đính kèm

Gội rồi mới Cạo

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

Thành viên tiêu biểu

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

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

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

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

File đính kèm

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

File đính kèm

Huyền thoại GPE

File đính kèm

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

File đính kèm

❆❆❆❆❆❆❆❆

Vũ Trần Khoa

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

❆❆❆❆❆❆❆❆

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

Thành viên tiêu biểu

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

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

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

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