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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
anhtuan1066

anhtuan1066

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

CÂU HỎI 1: Tại sao biến K ko hoạt động?
Tôi muốn khi nhấn vào 1 button thì cell A1 sẽ tăng lên 1 đơn vị... Tôi đã làm như sau:
-Tạo 1 Command Button (nút nhấn thuộc thanh Control Toolbox), click phải chuột lên nút nhấn, chọn View code, rồi gõ vào đoạn code sau:
PHP: 
Private Sub CommandButton1_Click()
   K = K + 1
   Range("A1").Value = K
End Sub
Ban đầu K chưa có gì, xem như =0, nhấn nút lần thứ nhất thì K dc tăng thêm 1, vậy K hiện tại sẽ bằng 1, và gán K vào cell A1 thì đương nhiên A1 sẽ =1... Nhấn nút lần 2, K lại dc tăng thêm 1 nên hiện tại K sẽ =2 và cell A1 cũng sẽ =2... vân vân.. từ đó diễn tiến tiếp...
Hi.. hi.. Điều này nghe qua có vẽ rất hợp lý, ấy thế mà khi nhấn nút nó chỉ hoạt động dc duy nhất 1 lần (A1 = 1) rồi thôi ko nhút nhít nữa...
Các bạn có thể giãi thích tại sao lại như thế ko? Tại sao những lần nhấn nút sau đó K lại ko tăng thêm tí nào (vì thực tế A1 vẫn cứ = 1 hoài) ?
ANH TUẤN
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Hằng số Pi trong VBA

Trên bảng tính, để lấy hằng số Pi ta dùng hàm Pi()
Vậy xin hỏi trong VBA, ngoài cách dùng WorksheetFunction.Pi() thì còn cách nào khác để lấy số Pi hay không?
 
Upvote 0
anhtuan1066 đã viết:
Trên bảng tính, để lấy hằng số Pi ta dùng hàm Pi()
Vậy xin hỏi trong VBA, ngoài cách dùng WorksheetFunction.Pi() thì còn cách nào khác để lấy số Pi hay không?
Nhấp chuột vào đây để mở rộng...

= Application.Acos(-1)

Khà khà khà, hông biết, hông biết! Trả lời trớt quớt cho vui.
 
Upvote 0
ptm0412 đã viết:
= Application.Acos(-1)

Khà khà khà, hông biết, hông biết! Trả lời trớt quớt cho vui.
Nhấp chuột vào đây để mở rộng...
Dạ vâng!
Hướng đi của sư phụ gần giống với cách làm của em!
Có điều sư phụ dùng Application thì cũng chẳng khác nào với WorksheetFunction
Hi... Hi...
Để ý trong VBA có hàm ATN
Ta có:
TAN(Pi/4) = 1
Nên
ATN(1) = Pi/4
Suy ra
Pi = 4 * ATN(1)
Xong!
 
Upvote 0
Thêm 1 câu hỏi (có liên quan đến số Pi)

Thêm 1 câu hỏi nữa, nó có liên quan đến số Pi
Xem hình:



View attachment 42777

- Với Input Value là vùng màu xanh, làm thế nào xây dụng 1 hàm người dùng để cho kết quả giống như vùng màu vàng?
Gơi ý: Có thể tưởng tượng thế này:
- Một hình vuông được đặt vào hệ trục tọa độ Ox, Oy sao cho tâm của hình vuông trùng với tâm O của hệ trục tọa độ
- Kết quả tại vùng màu vàng chính là tọa độ giao điểm của hình vuông với 4 trục đối xứng (của hình vuông)
(Pos hình và chỉnh này giờ mà sao nó vẫn ko dc vậy ta?)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Buồn buồn, chả có gì làm (hic). Ăn gian cho ngắn hàm.

PHP: 
Function ResultX(InputN As Long) As Long
    Dim A As Long
    A = InputN Mod 8
    ResultX = Cos(Application.Pi() / 4 * A)
End Function

PHP: 
Function ResultY(InputN As Long) As Long
    Dim B As Long
    B = InputN Mod 8
    ResultY = Sin(Application.Pi() / 4 * B)
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Thôi không ăn gian nữa, làm cho cụ thể tí.

PHP: 
Function ResultX(InputN As Long) As Double
    Dim A As Long
    A = InputN Mod 8
    Select Case A
        Case 0, 2, 4, 6
            ResultX = Cos(Application.Pi() / 4 * A)
        Case 1, 3
            ResultX = Tan(Application.Pi() / 4 * A)
        Case 5, 7
            ResultX = -Tan(Application.Pi() / 4 * A)
    End Select
End Function

PHP: 
Function ResultY(InputN As Long) As Double
    Dim B As Long
    B = InputN Mod 8
    Select Case B
        Case 0, 2, 4, 6
            ResultY = Sin(Application.Pi() / 4 * B)
        Case 1, 7
            ResultY = Tan(Application.Pi() / 4 * B)
        Case 3, 5
            ResultY = -Tan(Application.Pi() / 4 * B)
    End Select
End Function

Còn đây là hàm mảng tính 1 lần 2 ô:

PHP: 
Function ResultXY(InputN)
    Dim ResultTmp(1 To 2)
    Dim A As Long
    A = InputN Mod 8
    Select Case A
        Case 0, 2, 4, 6
            ResultTmp(1) = Cos(Application.Pi() / 4 * A)
            ResultTmp(2) = Sin(Application.Pi() / 4 * A)
        Case 1
            ResultTmp(1) = Tan(Application.Pi() / 4 * A)
            ResultTmp(2) = Tan(Application.Pi() / 4 * A)
        Case 5
            ResultTmp(1) = -Tan(Application.Pi() / 4 * A)
            ResultTmp(2) = -Tan(Application.Pi() / 4 * A)
        Case 3
            ResultTmp(1) = Tan(Application.Pi() / 4 * A)
            ResultTmp(2) = -Tan(Application.Pi() / 4 * A)
        Case 7
            ResultTmp(1) = -Tan(Application.Pi() / 4 * A)
            ResultTmp(2) = Tan(Application.Pi() / 4 * A)
    End Select
    ResultXY = ResultTmp

End Function
 
Upvote 0
ptm0412 đã viết:
Thôi không ăn gian nữa, làm cho cụ thể tí.

PHP: 
Function ResultX(InputN As Long) As Double
Dim A As Long
A = InputN Mod 8
Select Case A
Case 0, 2, 4, 6
ResultX = Cos(Application.Pi() / 4 * A)
Case 1, 3
ResultX = Tan(Application.Pi() / 4 * A)
Case 5, 7
ResultX = -Tan(Application.Pi() / 4 * A)
End Select
End Function

PHP: 
Function ResultY(InputN As Long) As Double
Dim B As Long
B = InputN Mod 8
Select Case B
Case 0, 2, 4, 6
ResultY = Sin(Application.Pi() / 4 * B)
Case 1, 7
ResultY = Tan(Application.Pi() / 4 * B)
Case 3, 5
ResultY = -Tan(Application.Pi() / 4 * B)
End Select
End Function

Còn đây là hàm mảng tính 1 lần 2 ô:

PHP: 
Function ResultXY(InputN)
Dim ResultTmp(1 To 2)
Dim A As Long
A = InputN Mod 8
Select Case A
Case 0, 2, 4, 6
ResultTmp(1) = Cos(Application.Pi() / 4 * A)
ResultTmp(2) = Sin(Application.Pi() / 4 * A)
Case 1
ResultTmp(1) = Tan(Application.Pi() / 4 * A)
ResultTmp(2) = Tan(Application.Pi() / 4 * A)
Case 5
ResultTmp(1) = -Tan(Application.Pi() / 4 * A)
ResultTmp(2) = -Tan(Application.Pi() / 4 * A)
Case 3
ResultTmp(1) = Tan(Application.Pi() / 4 * A)
ResultTmp(2) = -Tan(Application.Pi() / 4 * A)
Case 7
ResultTmp(1) = -Tan(Application.Pi() / 4 * A)
ResultTmp(2) = Tan(Application.Pi() / 4 * A)
End Select
ResultXY = ResultTmp
 
End Function
Nhấp chuột vào đây để mở rộng...

Sư phụ ơi!
Kết quả của hàm em cho vào file cụ thể đây! Sư phụ hãy so sánh với kết quả gốc nhé (có sai lệch)
Em xin nói thêm: Cái em cần là 1 hàm mảng ra kết quả cùng lúc 2 cell luôn (giống hàm ResultXY)
 

File đính kèm

Upvote 0
Sai lệch là vô cùng bé do tính tan = phương pháp gì đó của Bill:
6,12303E-17 ~ = 0
 
Upvote 0
ptm0412 đã viết:
Sai lệch là vô cùng bé do tính tan = phương pháp gì đó của Bill:
6,12303E-17 ~ = 0
Nhấp chuột vào đây để mở rộng...
Đấy... đấy chính là cái rắc rối mà em cần giải quyết!
Phải tuyệt đối chính xác chứ sư phụ (vì còn dùng kết quả để tính toán cho các bài toán khác cơ mà)
Sao sư phụ không dùng pp "ăn gian" giống ở trên nhỉ? Có sao đâu, miễn kết quả đúng... Em thì không gọi đấy là "ăn gian" mà cho rằng đấy là "sáng tạo"
 
Lần chỉnh sửa cuối:
Upvote 0
Phải tuyệt đối chính xác chứ sư phụ (vì còn dùng kết quả để tính toán cho các bài toán khác cơ mà)
Nhấp chuột vào đây để mở rộng...

Vậy thì dùng hàm round đi, dùng trong VBA ấy. Round(ResultTmp(), 10) vẫn còn đúng chứ đừng nói Round(xxx, 0).
Còn PP ăn gian là ép vào loại biến Long.

PHP: 
Function ResultXY(InputN As Long) 
    Dim A As Long, ResultTmp(1 to 2) As Long
    A = InputN Mod 8
    ResultTmp(1) = Cos(Application.Pi() / 4 * A)
    ResultTmp(2) = Sin(Application.Pi() / 4 * A)
    ResultXY = ResultTmp
End Function

Test rồi nha.
 
Upvote 0
ptm0412 đã viết:
Vậy thì dùng hàm round đi, dùng trong VBA ấy. Round(ResultTmp(), 10) vẫn còn đúng chứ đừng nói Round(xxx, 0).
Còn PP ăn gian là ép vào loại biến Long.

PHP: 
Function ResultXY(InputN As Long) 
Dim A As Long, ResultTmp(1 to 2) As Long
A = InputN Mod 8
ResultTmp(1) = Cos(Application.Pi() / 4 * A)
ResultTmp(2) = Sin(Application.Pi() / 4 * A)
ResultXY = ResultTmp
End Function

Test rồi nha.
Nhấp chuột vào đây để mở rộng...
Vâng! Em vẫn thích "an gian" hơn!
Mà sư phụ nè:
- Đâu cần Mod 8 làm gì chứ, với SIN, COS thì hết 1 vòng tròn sẽ quay lại từ đầu thôi
- Thay Application.Pi() / 4 bằng ATN(1) gọn hơn
Em mạn phép sửa lại chút
PHP: 
Function ResultXY(InputN As Long)
  Dim ResultTmp(1 To 2) As Long
  ResultTmp(1) = Cos(Atn(1) * InputN)
  ResultTmp(2) = Sin(Atn(1) * InputN)
  ResultXY = ResultTmp
End Function
 
Upvote 0
Em chưa dược học code mới học hàm thôi
các bác có thể chỉ cho em nơi nào học code
mà chương trình gì thì học nhanh nhất
 
Upvote 0
Le duy Thuong đã viết:
Em chưa dược học code mới học hàm thôi
các bác có thể chỉ cho em nơi nào học code
mà chương trình gì thì học nhanh nhất
Nhấp chuột vào đây để mở rộng...
Thì học ở đây chứ đâu nữa... Nếu có hứng thú hãy vào tham khảo 2 bài này:
Chập chững đến VBA! của sư phụ SA_DQ
và
Kiến thức cơ bản về Visual Basic for Applications (VBA) của thầy Phan Tự Hướng
Ngoài ra bạn cũng có thể mua sách do GPE xuất bản về xem
Còn cái vụ "nhanh nhất" thì e rằng hỏng có... Vì trên đời này chẳng có cái vụ học gì mà không cực khổ cả
Có hiên nhẫn ắc có thành công!
 
Upvote 0
Em xin nói thêm: Cái em cần là 1 hàm mảng ra kết quả cùng lúc 2 cell luôn (giống hàm ResultXY)
Nhấp chuột vào đây để mở rộng...
Sao sư phụ không dùng pp "ăn gian" giống ở trên nhỉ? Có sao đâu, miễn kết quả đúng... Em thì không gọi đấy là "ăn gian" mà cho rằng đấy là "sáng tạo"
Nhấp chuột vào đây để mở rộng...
anhtuan1066 đã viết:
Vâng! Em vẫn thích "an gian" hơn!
Nhấp chuột vào đây để mở rộng...

Hình như mình bị trúng kế khích tướng thì phải? Ặc ặc!

Không sao, chỉ chuyển mỗi cái As Long từ dòng trên xuống dòng dưới thôi mà.
 
Lần chỉnh sửa cuối:
Upvote 0
Hihihi! Code hay quá!
Em cũng xin đề một bài đơn giản nhưng yêu cầu thuật toán cao nha! hihi
Đề: Tính số tiền Taxi chạy trên đường với bảng Km như sau:
Km <=2 thì lấy 15đ
3<=Km<=50 thì lấy 10đ/km
51<=Km<=200 thì lấy 7đ/Km
Km>200 thì lấy 5đ/km

Nếu xe đi 1m cũng lấy 15đ
Xe đi 10Km thì 2Km đầu là 15đ còn 8Km sau thì lấy 10đ/Km
Nếu Km bị âm thì hàm xuất dòng thông báo lỗi.
Thân.
[p/s: Nếu em tìm thấy đề nào hay hay thì em sẽ kiếm mấy bác làm phiền chơi nha! hihihi:D Nhớ mọi người rất nhiều!]
 
Upvote 0
Tay này ra đề có chuyện rồi:
2,001Km đến 2,999Km =?
50,001Km đến 50,999Km=?
 
Upvote 0
Po_Pikachu đã viết:
Hihihi! Code hay quá!
Em cũng xin đề một bài đơn giản nhưng yêu cầu thuật toán cao nha! hihi
Đề: Tính số tiền Taxi chạy trên đường với bảng Km như sau:
Km <=2 thì lấy 15đ
3<=Km<=50 thì lấy 10đ/km
51<=Km<=200 thì lấy 7đ/Km
Km>200 thì lấy 5đ/km

Nếu xe đi 1m cũng lấy 15đ
Xe đi 10Km thì 2Km đầu là 15đ còn 8Km sau thì lấy 10đ/Km
Nếu Km bị âm thì hàm xuất dòng thông báo lỗi.
Thân.
[p/s: Nếu em tìm thấy đề nào hay hay thì em sẽ kiếm mấy bác làm phiền chơi nha! hihihi:D Nhớ mọi người rất nhiều!]
Nhấp chuột vào đây để mở rộng...
Nếu đi được 2.5 Km thì lấy bao nhiêu?
Ẹc... Ẹc...
(bài này hao hao giống với tính thuế thu nhập cá nhân và tính tiền điện nhỉ ---> Đúng "bài" của anh Sealand rồi còn gì)
 
Upvote 0
Ndu "hich" 1 cái làm mình phấn khích nên cũng tham gia xem sao

PHP: 
Function Cuoc(Dai As Double) As Variant
If Dai <= 0 Then Cuoc = 0: Cuoc = IIf(Dai = 0, 0, "Sai Km"): Exit Function
If Dai > Int(Dai) Then Dai = Int(Dai) + 1
Cuoc = Dai
Select Case Dai
Case Is > 200
Cuoc = Dai * 5
Case Is > 50
Cuoc = Dai * 7
Case Is > 10
Cuoc = Dai * 10
Case Is = 10
Cuoc = 110
Case Is < 10
Cuoc = Dai * 15
End Select
End Function

Minh phân vân vì tác giả đòi thuật toán cao nhưng mình thì "Chuyện thường ngày ở huyện."
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Ndu "hich" 1 cái làm mình phấn khích nên cũng tham gia xem sao

PHP: 
Function Cuoc(Dai As Double) As Variant
If Dai <= 0 Then Cuoc = 0: Cuoc = IIf(Dai = 0, 0, "Sai Km"): Exit Function
If Dai > Int(Dai) Then Dai = Int(Dai) + 1
Cuoc = Dai
Select Case Dai
Case Is > 200
Cuoc = Dai * 5
Case Is > 50
Cuoc = Dai * 7
Case Is > 10
Cuoc = Dai * 10
Case Is = 10
Cuoc = 110
Case Is < 10
Cuoc = Dai * 15
End Select
End Function
Minh phân vân vì tác giả đòi thuật toán cao nhưng mình thì "Chuyện thường ngày ở huyện."
Nhấp chuột vào đây để mở rộng...
Theo em nghĩ, bài toán này phải tính theo lũy tiến chứ anh
Với số Km = 11, sao UDF của anh cũng ra kết quả = 110 vậy? (bằng luôn với trường hợp Km = 10)
 
Upvote 0
Nếu tính luỹ tiến thì câu điếu kiện 10Km phải là từ 10 đến 50Km là: 2km giá 15 còn lại giá 10.
Mình sửa lại theo dạng luỹ tiến:

PHP: 
Function Cuoc1(Dai As Double) As Variant
If Dai <= 0 Then Cuoc = 0: Cuoc = IIf(Dai = 0, 0, "Sai Km"): Exit Function
If Dai > Int(Dai) Then Dai = Int(Dai) + 1
Cuoc = Dai
Select Case Dai
Case Is > 200
Cuoc = (Dai - 200) * 5 + 1560
Case Is > 50
Cuoc = (Dai - 50) * 7 + 510
Case Is > 9
Cuoc = (Dai - 2) * 10 + 30
Case Is < 10
Cuoc = Dai * 15
End Select
End Function
Nếu chỉ tính từ 1m trở đi còn dưới 1 m bỏ thì sửa câu lệnh

If Dai > Int(Dai) Then Dai = Int(Dai) + 1

Thành:

If Dai*100 > Int(Dai*100) Then Dai = Int(Dai) + 1
 
Lần chỉnh sửa cuối:
Upvote 0
Định nghĩa 1 biến dạng WorksheetFunction

Tôi có đoạn code thế này:
PHP: 
Sub Test()
  MsgBox WorksheetFunction.And(1, 1)
End Sub
Code chạy không có vấn đề (MsgBox cho kết quả là TRUE)
Tôi sửa code trên thành:
PHP: 
Sub Test()
  Dim Func As WorksheetFunction
  MsgBox Func.And(1, 1)
End Sub
Nghĩ rằng chẳng có vấn đề gì với code này cả, ấy thế mà khi chạy nó lại báo lổi
Xin hỏi tại sao lại vậy? Hi... Hi...
(Tin chắc không ít người đã từng gặp vấn đề này rồi)
 
Upvote 0
sealand đã viết:
Tay này ra đề có chuyện rồi:
2,001Km đến 2,999Km =?
50,001Km đến 50,999Km=?
Nhấp chuột vào đây để mở rộng...

hihihi! Vâng tất nhiên là em có chuyện mới viết đề thế này chứ! hihihi
Đề này mục đích không phải là xử lý cho đúng trường hợp. Còn chuyện lỗi kia là cố ý đó.
Các bác viết Function() Nhưng chỉ được dùng 1 IF để xử lý trường hợp lỗi kia thôi nhé! <Thuật toán mà>
Các trường hợp dễ thì mọi người viết rồi. Giờ tới lúc nâng cao nào?!
Thân.
 
Upvote 0
Đề 2:
Hãy cho biết năm X này là năm nhuận hay thường?
+Có 2 trường hợp sử lý năm nhuận như sau:
-Trường hợp năm đầu thế kỷ <như 1800, 1900, 2000,...> thì nó chia hết cho 400 thì nhuận <Ngược lại thì không>
-Trường hợp năm thường <như 1986,...> thì nó chia hết cho 4 thì nhuận <Ngược lại thì không>

Với đề này chắc là hơi dể nhỉ? Nên em đề nghị viết 2 cách giải trở lên và cách sau phải ngắn hơn cách trước nha.
Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Người đi đầu dễ va vấp nhưng có chùng cho người sau bước. Mình dùng công thức chỉ có 1 if(), ô có Name là Nam chứa giá trị năm:


=IF(OR(AND(MOD(Nam,100)<>0,MOD(Nam,4)=0),AND(MOD(Nam,100)=0,MOD(Nam,400)=0)),"Nhuan","Khong")
 
Upvote 0
Po_Pikachu đã viết:
Đề 2:
Hãy cho biết năm X này là năm nhuận hay thường?
+Có 2 trường hợp sử lý năm nhuận như sau:
-Trường hợp năm đầu thế kỷ <như 1800, 1900, 2000,...> thì nó chia hết cho 400 thì nhuận <Ngược lại thì không>
-Trường hợp năm thường <như 1986,...> thì nó chia hết cho 4 thì nhuận <Ngược lại thì không>

Với đề này chắc là hơi dể nhỉ? Nên em đề nghị viết 2 cách giải trở lên và cách sau phải ngắn hơn cách trước nha.
Thân.
Nhấp chuột vào đây để mở rộng...
Rất nhiều người bản cải về vụ năm nhuận này... Tôi thì cho rằng chúng ta đang làm việc trên Excel thì cớ gì phải đi tính toán cái đã có sẳn chứ!
Xem ngày trong tháng 2 của năm X, nếu là là 29 thì NHUẬN, ngược lại thì KHÔNG NHUẬN
Tất cả dựa vào ngày này: DAY(DATE(X,3,0)) mà IF ---> Đơn giản thế thôi!
Việc năm ấy thuộc năm đầu thế kỷ hay.. gì gì đó, đã có Excel lo hộ cho ta rồi
 
Lần chỉnh sửa cuối:
Upvote 0
Sự khác nhau giữa 2 cách xử lý Range

- Tôi có 1 vùng được đặt tên trong Define Name là Data
- Tôi có 2 đoạn code như sau:
PHP: 
Sub Test1()
  With Range("Data")
    .Offset(.Rows.Count, .Columns.Count).Resize(1, 1).Select
  End With
End Sub
Và
PHP: 
Sub Test2()
  With Range("Data")
    .Resize(1, 1).Offset(.Rows.Count, .Columns.Count).Select
  End With
End Sub
Thử suy nghĩ xem 2 đoạn này khác nhau ở điểm quan trọng nào?
Hay nói chính xác hơn thì theo ý các bạn, ta nên dùng đoạn code nào là hợp lý?
(câu này khá dể, mời thử sức nha)
 
Upvote 0
Làm sao phát hiện được tình huống "CHƯA GÕ GÌ VÀO INPUTBOX"

Tôi có đoạn code như sau:
PHP: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  .... Làm công việc tiếp theo ...
End Sub
Ý tôi muốn rằng: Nếu thật sự tôi có gõ gì vào InputBox thì mới "Làm công việc tiếp theo", ngược lại thì không làm gì cả!
--------------------------------
Tôi đã thí nghiệm:
PHP: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 then
  .... Làm công việc tiếp theo ...
  End If
End Sub
===> Cóc được
PHP: 
 Sub Test()
   Dim Text As String
   Text = Application.InputBox("Go gi do vao day!", Type:=2)
   If Text <> "" then
   .... Làm công việc tiếp theo ...
  End If
 End Sub
Cũng.. cóc được luôn!
------------------------------------------
Xin hỏi các bạn ta phải xử lý thế nào?
------------------------------------------
(Bài này rất dể nhưng hơi bị.. tức đây!)
Ẹc.. Ẹc...
 
Upvote 0
Anh ơi,
Anh nói em chưa hiểu lắm.
Em thử đoạn code của anh
Mã: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 Then
    MsgBox "Hello"
  '
  End If
End Sub
Em thử nhập vào thì nó vẫn thực hiện các lệnh tiếp theo chứ anh?

Lê Văn Duyệt
 
Upvote 0
levanduyet đã viết:
Anh ơi,
Anh nói em chưa hiểu lắm.
Em thử đoạn code của anh
Mã: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 Then
    MsgBox "Hello"
  '
  End If
End Sub
Em thử nhập vào thì nó vẫn thực hiện các lệnh tiếp theo chứ anh?

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...
Thế Duyệt có thử bấm Cancel chưa? ---> Ẹc.. Ẹc...
Đấy mới là vấn đề
Tóm lại: Code của Duyệt dù có Cancel hay OK thì.. VẪN NHƯ NHAU!
 
Upvote 0
ndu96081631 đã viết:
Thế Duyệt có thử bấm Cancel chưa? ---> Ẹc.. Ẹc...
Đấy mới là vấn đề
Tóm lại: Code của Duyệt dù có Cancel hay OK thì.. VẪN NHƯ NHAU!
Nhấp chuột vào đây để mở rộng...
Hi anh, cái này không phải code của em. Hi hi hi.

Vậy thì anh xem cái code này (chỉ là ví dụ tham khảo thôi):
Mã: 
Sub RangeDataType()

Dim rRange As Range
    [COLOR="red"]On Error Resume Next[/COLOR]
        Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)
    [COLOR="red"]On Error GoTo 0[/COLOR]
        [COLOR="red"]Application.DisplayAlerts = True[/COLOR]
        If rRange Is Nothing Then
            Exit Sub
        Else
            rRange.Font.Bold = True
        End If
End Sub
Chú ý mấy cái màu đỏ đỏ.
Nguồn từ đây
Theo em về cơ bản để trả lời câu hỏi của anh thì phải biết được cấu trúc của Application.InputBox.

Lê Văn Duyệt
 
Upvote 0
levanduyet đã viết:
Hi anh, cái này không phải code của em. Hi hi hi.

Vậy thì anh xem cái code này (chỉ là ví dụ tham khảo thôi):
Mã: 
Sub RangeDataType()

Dim rRange As Range
    [COLOR=red]On Error Resume Next[/COLOR]
        Application.DisplayAlerts = False

            Set rRange = Application.InputBox(Prompt:= _
                "Please select a range with your Mouse to be bolded.", _
                    Title:="SPECIFY RANGE", Type:=8)
    [COLOR=red]On Error GoTo 0[/COLOR]
        [COLOR=red]Application.DisplayAlerts = True[/COLOR]
        If rRange Is Nothing Then
            Exit Sub
        Else
            rRange.Font.Bold = True
        End If
End Sub
Chú ý mấy cái màu đỏ đỏ.
Nguồn từ đây
Theo em về cơ bản để trả lời câu hỏi của anh thì phải biết được cấu trúc của Application.InputBox.

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...
Nếu là Range thì dể rồi, Với biến Range tôi thường làm vầy:
PHP: 
Sub Test()
  Dim SrcRng As Range
  On Error Resume Next
  Set SrcRng = Application.InputBox("Chon vung", Type:=8)
  If Not SrcRng Is Nothing Then
    MsgBox SrcRng.Address
  End If
End Sub
Trước giờ xài tốt, hoàn toàn không có vấn đề gì... Nhưng ở đây cái ta nhập vào InputBox là dạng chuổi (Type:=2) ---> dù Duyệt có nhập hay không nhập vào InputBox thì chuổi ấy vẫn tồn tại ---> Vậy có gì phân biệt giữa việc CÓ NHẬP và KHÔNG NHẬP?
Thế mới "khoai" chứ!
Không biết các bạn khác có ai từng gặp tình huống này không nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
Theo em:
CÓ NHẬP
Len(...)>0
KHÔNG NHẬP
1. Cancel
2. Len(...)=0

Ở đây vấn đề là anh nói trường hợp 2. Vậy thì với ví dụ trên anh chỉ việc thay thế theo ý anh thôi.
Chú ý:
1. Có nhập vào thì len(text)>0 và text<>False
2. Nếu người dùng Cancel hay Esc, text=False
3. Nếu không nhập vào mà nhấn OK thì Len(text)=0

Lê Văn Duyệt
 
Upvote 0
levanduyet đã viết:
Theo em:
CÓ NHẬP
Len(...)>0
KHÔNG NHẬP
1. Cancel
2. Len(...)=0

Ở đây vấn đề là anh nói trường hợp 2. Vậy thì với ví dụ trên anh chỉ việc thay thế theo ý anh thôi.
Chú ý:
1. Có nhập vào thì len(text)>0 và text<>False
2. Nếu người dùng Cancel hay Esc, text=False
3. Nếu không nhập vào mà nhấn OK thì Len(text)=0

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...
Chính xác đến... 99.99%
Tức sửa lại code như sau:
PHP: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 And Text <> "False" Then
    MsgBox Text
  End If
End Sub
Chỉ có 1 vấn đề nhỏ xíu nữa, đó là nếu tôi gõ chữ False vào InputBox thì lý ra cũng phải xuất hiện MsgBox (vì tôi có gõ vào mà)... đàng này nó chẳng làm gì cả!
Tóm lại:
- Nếu tôi bấm Cancel thì Text trả về giá trị = False
- Vậy nếu tôi gõ vào chữ False thì có gì phân biệt giữa trường hợp này với trường hợp bấm nút Cancel?
--------------------------------------------------------------------------------
(Bởi vậy mới nói đây là bài dể nhưng mà cũng rất.. dể tức...)
Tuy nhiên đây vẫn là cách xử lý tốt nhất cho đến thời điểm hiện giờ!
Cảm ơn Duyệt!
--------------------------------------------------------------------------------
Vẫn còn 1 cách khác tuyệt đối chính xác (100%) ngay cả trường hợp gõ chữ False vào InputBox ---> Mời các cao thủ nghiên cứu
Lưởi câu đây nha! Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Chính xác đến... 99.99%
Tức sửa lại code như sau:
PHP: 
Sub Test()
  Dim Text As String
  Text = Application.InputBox("Go gi do vao day!", Type:=2)
  If Len(Text) > 0 And Text <> "False" Then
    MsgBox Text
  End If
End Sub
Chỉ có 1 vấn đề nhỏ xíu nữa, đó là nếu tôi gõ chữ False vào InputBox thì lý ra cũng phải xuất hiện MsgBox (vì tôi có gõ vào mà)... đàng này nó chẳng làm gì cả!
Tóm lại:
- Nếu tôi bấm Cancel thì Text trả về giá trị = False
- Vậy nếu tôi gõ vào chữ False thì có gì phân biệt giữa trường hợp này với trường hợp bấm nút Cancel?
--------------------------------------------------------------------------------
(Bởi vậy mới nói đây là bài dể nhưng mà cũng rất.. dể tức...)
Tuy nhiên đây vẫn là cách xử lý tốt nhất cho đến thời điểm hiện giờ!
Cảm ơn Duyệt!
--------------------------------------------------------------------------------
Vẫn còn 1 cách khác tuyệt đối chính xác (100%) ngay cả trường hợp gõ chữ False vào InputBox ---> Mời các cao thủ nghiên cứu
Lưởi câu đây nha! Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...
Theo tôi thì tùy từng trường hợp mà xử lý, ở đây bạn muốn lấy về dữ liệu kiểu chuỗi, vậy đơn giản hơn là ta dùng hàm InputBox thay cho phương thức Application.InputBox là ok ngay. Về phía người dùng sẽ không thấy có sự khác nhau. Sử dụng phương thức Application.InputBox thì hơn ở chỗ là áp được kiểu của người dùng nhập vào do đó không cần phải xử lý về kiểu nữa. Còn ở đây có lẽ là bác NDU đang định đánh đố với trường hợp cụ thể này thì phải. Nếu vậy thì có thể tạm dùng cách như sau:
Mã: 
Sub Test()
    Dim Text ' As String
    Text = Application.InputBox("Go gi do vao day!", Type:=2)
    If Len(Text) > 0 And TypeName(Text) = "String" Then
        MsgBox Text
    End If
End Sub
Tuy nhiên nếu Type không phải là 2 mà thay vào đó là 4 thì tôi không rõ là phải giải quyết ra sao.
 
Upvote 0
Không phân biệt được giữa người dùng nhập vào "Cancel" hay người dùng nhấn "Cancel" đây là vấn đề nhiều người đã bàn (các forum nước ngoài cũng vậy)
Đúng là ta chỉ tuỳ trường hợp mà làm thôi. Nếu trong trường hợp là số thì lại gặp vấn đề giữa "0" nhập vào vào việc người dùng nhấn "cancel". Vì lúc này khi người dùng nhấn "cancel" thì cũng trả về giá trị là "0".
Tham khảo thêm:
Mã: 
Sub Using_InputBox_Function()
      Dim Show_Box As Boolean
      Dim Response As Variant

      ' Set the Show_Dialog variable to True.
      Show_Box = True

      ' Begin While loop.
      While Show_Box = True

         ' Show the input box.
         Response = InputBox("Enter a number.", _
            "Number Entry", , 250, 75)

         ' See if Cancel was pressed.
         If Response = "" Then

            ' If Cancel was pressed,
            ' break out of the loop.
            Show_Box = False
         Else
            ' Test Entry to find out if it is numeric.
            If IsNumeric(Response) = True Then
               ' Write the number to the first
               ' cell in the first sheet in the active
               ' workbook.
               Worksheets(1).Range("a1").Value = Response
               Show_Box = False
            Else
               ' If the entry was wrong, show an error message.
               MsgBox "Please Enter Numbers Only"
            End If
         End If
      ' End the While loop.
      Wend
   End Sub
Từ Mr.M$


Lê Văn Duyệt
PS: trả lời tàm tạm không biết anh Tuấn có đãi gì không nữa.
 
Upvote 0
rollover79 đã viết:
Theo tôi thì tùy từng trường hợp mà xử lý, ở đây bạn muốn lấy về dữ liệu kiểu chuỗi, vậy đơn giản hơn là ta dùng hàm InputBox thay cho phương thức Application.InputBox là ok ngay. Về phía người dùng sẽ không thấy có sự khác nhau.
Nhấp chuột vào đây để mở rộng...
Ẹc... Ẹc... Chuẩn không còn gì để chỉnh nữa
rollover79 mà ra tay thì... TUYỆT!
(Lưu ý: Ở đây đang xét trường hợp là CHUỔI)
-----------------------
Với levanduyet:
Để mình nghiên cứu lại code của Duyệt cái đã... (nó hơi bị cao siêu)
Nhưng nói chung, đã là đố vui thì chủ yếu dựa vào MẸO thôi ---> Không cố tình gây rắc rối về code (mà thật sự mình cũng không đủ khả năng để GÂY RẮC RỐI)
 
Lần chỉnh sửa cuối:
Upvote 0
Anh ơi,
Ans đã viết:
dùng hàm InputBox thay cho phương thức Application.InputBox
Nhấp chuột vào đây để mở rộng...
Cái này cần phải xem lại. Nếu chỉ nói đến chuỗi thôi thì em nghĩ cũng chấp nhận được.

Lê Văn Duyệt
 
Upvote 0
Sai sót với hàm UniqueList

Trên diển đàn có rất nhiều bài viết về việc dùng Dictionary Object để lấy list duy nhất! Nay xin đưa lên 1 ví dụ nhỏ dùng làm câu đố vui
- Tôi có dữ liệu như hình:

untitled..JPG

- Tôi có đoạn code:
PHP: 
Function UniqueList(SrcArray)
  Dim Item
  With CreateObject("Scripting.Dictionary")
    For Each Item In SrcArray
      If Not .Exists(Item) And Item <> "" Then .Add Item, ""
    Next
    UniqueList = .Keys
  End With
End Function
Nhìn sơ qua chưa thấy có gì không ổn cả, vậy mà khi kiểm tra thì:
a) Công thức =SUMPRODUCT(1/COUNTIF(A1:A6,A1:A6)) cho kết quả =3
b) Công thức =COUNTA(UniqueList(A1:A6)) lại cho kết quả = 6
c) Quét chọn đoạn UniqueList(A1:A6) trên thanh Formula rồi bấm F9 ta nhìn thấy kết quả {"a","b","c","a","b","c"}
d) Có vẽ như hàm trên chẳng lọc được danh sách duy nhất gì cả, có bao nhiêu nó lấy hết
------------------------------
Xin hỏi hàm trên cần sửa lại chổ nào?
Xin lưu ý rằng: Tôi muốn biến SrcArray và Item phải là Variant (để có thể làm việc được với Range và cả Array)
 

File đính kèm

Upvote 0
Anh ơi,
Mã: 
With CreateObject("Scripting.Dictionary")
        If Not TypeOf SrcArray Is Range Then
            For Each Item In SrcArray
                If Not .Exists(Item) And Item <> "" Then .Add Item, ""
            Next
        Else
            For Each Item In SrcArray.Value
                If Not .Exists(Item) And Item <> "" Then .Add Item, ""
            Next
        End If
        UniqueList = .Keys
End With

PS: Anh ơi làm hoài không có thưởng gì hết. Hu hu hu !
 
Lần chỉnh sửa cuối:
Upvote 0
levanduyet đã viết:
Anh ơi,
Mã: 
If Not TypeOf SrcArray Is Range Then
With CreateObject("Scripting.Dictionary")
For Each Item In SrcArray
If Not .Exists(Item) And Item <> "" Then
.Add Item, ""
Debug.Print Item
End If
Next
UniqueList = .Keys
End With
Else
With CreateObject("Scripting.Dictionary")
For Each Item In SrcArray.Value
If Not .Exists(Item) And Item <> "" Then
.Add Item, ""
Debug.Print Item
End If
Next
UniqueList = .Keys
End With
 
End If
Nhấp chuột vào đây để mở rộng...
Hi... hi... Chính xác! Nhưng đâu cần búa to thế Duyệt ơi!
Còn cách khác, chỉ thêm duy nhất 1 dòng code (cực ngắn)
(Dù sao cũng lại học được thêm chiêu TypeOf SrcArray Is Range)
 
Lần chỉnh sửa cuối:
Upvote 0
anhtuan1066 đã viết:
Trên diển đàn có rất nhiều bài viết về việc dùng Dictionary Object để lấy list duy nhất! Nay xin đưa lên 1 ví dụ nhỏ dùng làm câu đố vui
- Tôi có dữ liệu như hình:

View attachment 44160

- Tôi có đoạn code:
PHP: 
Function UniqueList(SrcArray)
  Dim Item
  With CreateObject("Scripting.Dictionary")
    For Each Item In SrcArray
      If Not .Exists(Item) And Item <> "" Then .Add Item, ""
    Next
    UniqueList = .Keys
  End With
End Function
Nhìn sơ qua chưa thấy có gì không ổn cả, vậy mà khi kiểm tra thì:
a) Công thức =SUMPRODUCT(1/COUNTIF(A1:A6,A1:A6)) cho kết quả =3
b) Công thức =COUNTA(UniqueList(A1:A6)) lại cho kết quả = 6
c) Quét chọn đoạn UniqueList(A1:A6) trên thanh Formula rồi bấm F9 ta nhìn thấy kết quả {"a","b","c","a","b","c"}
d) Có vẽ như hàm trên chẳng lọc được danh sách duy nhất gì cả, có bao nhiêu nó lấy hết
------------------------------
Xin hỏi hàm trên cần sửa lại chổ nào?
Xin lưu ý rằng: Tôi muốn biến SrcArray và Item phải là Variant (để có thể làm việc được với Range và cả Array)
Nhấp chuột vào đây để mở rộng...
Nguyên nhân sai là do biến item kiểu variant và đầu vào là 1 range, vì khi đó mỗi item add vào đối tượng dictionary là 1 range, mà range A1 thì khác với range A4 mặc dù đều chứa giá trị là "a". Cách sửa có thể thêm 1 dòng sau dòng for each như sau: item = item & ""
 
Upvote 0
rollover79 đã viết:
Nguyên nhân sai là do biến item kiểu variant và đầu vào là 1 range, vì khi đó mỗi item add vào đối tượng dictionary là 1 range, mà range A1 thì khác với range A4 mặc dù đều chứa giá trị là "a". Cách sửa có thể thêm 1 dòng sau dòng for each như sau: item = item & ""
Nhấp chuột vào đây để mở rộng...
Lý giải của rollover79 là hoàn toàn hợp lý, tuy nhiên về biện pháp khắc phục thì.. có vẽ chưa ổn lắm
Item = Item & "" vô tình đã biến mọi kiểu dữ liệu thành chuổi mất rồi
Tôi cũng có cách xử lý khác:
- Khai báo thêm 1 biến (Temp)
- Gán Temp = SrcArray
- Từ đoạn này sẽ làm việc với Temp thay vì SrcArray
PHP: 
Function UniqueList(SrcArray)
  Dim Item, Temp
  Temp = SrcArray
  With CreateObject("Scripting.Dictionary")
    For Each Item In Temp
      If Not .Exists(Item) And Item <> "" Then .Add Item, ""
    Next
    UniqueList = .Keys
  End With
End Function
Động tác này có tác dụng:
- Nếu SrcArray là Array thì Temp đương nhiên cũng là Array
- Nếu SrcArray là Range thì động tác gán trên tương đương với Temp = SrcArray.Value
- Và nói chung thì cho dù SrcArray là cái gì, Temp vẫn cứ là 1 Array
(Cách khác gọn hơn: SrcArray = SrcArray... không cần thêm biến. Tuy nhiên vẩn cảm giác thiếu "an toàn" với cách này)
-------------------------------
Khả năng của tôi chỉ biết được đến đây. Duyệt và rollover79 có góp ý thêm gì không?
 
Upvote 0
Ứng dụng chỉ chạy được khi Disable Macro

Giả sử tôi có:
- 1 file Excel có chứa code gì đó (không quan trọng là code gì, miễn có code)
- Đương nhiên nếu mở file thì sẽ có cảnh báo về Macros (nếu đặt security ở mức Medium)
- Trong file tôi xây dựng 1 ứng dụng
- Ứng dụng này chỉ chạy được nếu lúc mở file ta bấm vào nút Disable Macros (bấm Enable Macros sẽ làm tê liệt ứng dụng)
---------------------------------
Các bạn thử nghĩ xem ứng dụng ấy có thể là.. cái gì mà kỳ cục vậy?
 
Upvote 0
Thử 1 trong 3 code này xem, nói chung là nhiều lắm. Khi enable macro 1 cái thì chả làm được cái giống gì, đừng nói là ứng dụng.

PHP: 
Private Sub Workbook_Open()
Application.Quit
End Sub

PHP: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sheet1.Activate
End Sub

PHP: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveSheet.[a1].Select
End Sub
 
Upvote 0
ptm0412 đã viết:
Thử 1 trong 3 code này xem, nói chung là nhiều lắm. Khi enable macro 1 cái thì chả làm được cái giống gì, đừng nói là ứng dụng.

PHP: 
Private Sub Workbook_Open()
Application.Quit
End Sub

PHP: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sheet1.Activate
End Sub

PHP: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveSheet.[a1].Select
End Sub
Nhấp chuột vào đây để mở rộng...
Hình như sư phụ hiểu lầm ý em!
Ý em hỏi: Liệu đấy có thể là ứng dụng gì? (không liên quan đến code)
Trong file có code chỉ với mục đích cho người dùng chọn Disable Macros hay Enable Macros mà thôi! (code ấy là gì không quan trọng)
 
Upvote 0
Hình trong ComboBox này ở đâu mà ra

- Các bạn hãy tải file đính kèm này về và mở lên
- Bấm nút Load Image để chạy code
- Bấm vào mũi tên xổ xuống trên ComboBox, các bạn sẽ thấy có.. hình trong đó


untitled.JPG


Câu hỏi: Hình này ở đâu ra?
(Hi... hi... thú vị đây! Nếu hiểu được thì từ bây giờ các bạn sẽ thấy việc đưa hình vào ComboBox dể hơn ăn cháo)
 

File đính kèm

Upvote 0
Chắc là ở đây hén?

Combo.jpg
 
Upvote 0
Ẹc cái gì mà ẹc, trả lời nhanh quá, người khác lấy gì mà tìm hiểu và trả lời? Câu đố đoản thọ mất. Còn hông chịu nhấn cám ơn đi!
Mà chọc tức zậy mới "chết tiệt" chớ!
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Ẹc cái gì mà ẹc, trả lời nhanh quá, người khác lấy gì mà tìm hiểu và trả lời? Câu đố đoản thọ mất. Còn hông chịu nhấn cám ơn đi!
Mà chọc tức zậy mới "chết tiệt" chớ!
Nhấp chuột vào đây để mở rộng...

Biết mờ, thấy để cái "logo" cheettit là biết lão biết ở đâu ra rồi! Vào Thư mục Windows lục xem nó ở đâu cũng chẳng thấy, chuyển Fonts cũng chẳng tác dụng, Properties nó, rồi cho nó Linkcell, nó cũng chẳng cho kết quả! Ẹc ... Ẹc...
 
Upvote 0
Vào Thư mục Windows lục xem nó ở đâu cũng chẳng thấy, chuyển Fonts cũng chẳng tác dụng,
Nhấp chuột vào đây để mở rộng...
Chép về máy có mỗi 1 file Excel, mà nghĩ là có cái gì đó trong windows?
Mấy cái mặt cười còn nghĩ nó là Font phiếc, chứ cái avatar cheettit thì làm gì có trong font mà đổi!

Tìm sai hướng mất gồi!
Hướng tìm nằm trong code: trong code có câu .Add "pict" & i nghĩa là có trên đời 3 cái pict1, pict2 và pict3
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Chép về máy có mỗi 1 file Excel, mà nghĩ là có cái gì đó trong windows?
Mấy cái mặt cười còn nghĩ nó là Font phiếc, chứ cái avatar cheettit thì làm gì có trong font mà đổi!

Tìm sai hướng mất gồi!
Hướng tìm nằm trong code: trong code có câu .Add "pict" & i nghĩa là có trên đời 3 cái pict1, pict2 và pict3
Nhấp chuột vào đây để mở rộng...

Thầy ơi, em thấy trong File ẩn đâu đó một cái ImageList1 mà em chẳng thấy nó nằm ở đâu mới ghê!
 
Upvote 0
ptm0412 đã viết:
Hướng tìm nằm trong code: trong code có câu .Add "pict" & i nghĩa là có trên đời 3 cái pict1, pict2 và pict3
Nhấp chuột vào đây để mở rộng...
Thế nhưng đoạn code ấy sửa thành:
.ComboItems.Add i, "", "", i
Chẳng có cái Pic nào trên đời này cả ---> Nó vẫn chạy!
Ẹc... Ẹc...
------------------------------------------------------
minhthien321 đã viết:
Thầy ơi, em thấy trong File ẩn đâu đó một cái ImageList1 mà em chẳng thấy nó nằm ở đâu mới ghê!
Nhấp chuột vào đây để mở rộng...
Nó "lặn mất tăm" rồi, lấy đâu mà thấy
Tìm cách cho no "hiện ra" đi!
 
Lần chỉnh sửa cuối:
Upvote 0
Biết là thế, nhưng lỡ thấy pict1 rồi thì đi tìm pict1, tìm không ra pict1 biết đâu lại thấy cái khác. Khà khà khà!

Cái khác là cái ImageList1 mà minhthien tìm thấy đó! Đâu đó trong file!
 
Lần chỉnh sửa cuối:
Upvote 0
Hiện lên rồi, nó nằm ở cột AZ đấy! Để tiếp tục xem tác dụng hiehiehie
 
Upvote 0
Không có ImageList1, nó không chạy code. Cho For i = 1 to (>) 3 Code lỗi.
=> Trong ImageList1 mặc định có 3 cái pict thôi.

Muốn insert pict chắc có lẽ dùng class thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
minhthien321 đã viết:
Không có ImageList1, nó không chạy code. Cho For i = 1 to (>) 3 Code lỗi.
=> Trong ImageList1 mặc định có 3 cái pict thôi.

Muốn insert pict chắc có lẽ dùng class thôi.
Nhấp chuột vào đây để mở rộng...
Đâu có khó khăn thế! Class gì đó thì còn gì là ĐỐ VUI!
------------------------------------------------------------
- Bấm nút Design Mode
- Click phải vào ImageList1, chọn ImageList Ctrl Object\Properties
- Chuyển sang tab Images sẽ thấy ngay cách Insert Picture
------------------------------------------------------------
Nếu đã nghiên cứu và hiểu rõ cách làm trên file này, các bạn hãy cải tiến sao cho có thể dùng được ImageCombo trên UserForm nhé
(Lưu ý: Áp dụng y chang như file đã gữi)
 
Upvote 0
anhtuan1066 đã viết:
- Click phải vào ImageList1, chọn ImageList Ctrl Object\Properties
Nhấp chuột vào đây để mở rộng...

Đây chính là cái mà rất nhiều người không để ý đến. Các control vẽ lên sheet ngoài cái property chung còn có property riêng của nó nữa. Chính những properties này mới là đặc thù của chính cái control, mà ai không biết sẽ không dùng hết tính năng hoặc cho rằng control không hoạt động.

Thí dụ cái Date&Time Picker 6.0, nếu không biết sẽ cho rằng khi lọc ngày tháng bằng control này không chính xác, mà quên rằng ngay trong tên gọi của nó đã hàm chứa cái Time và mặc định cái Time này <>0.
(Kinh nghiệm xương máu đấy nhé)
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Đây chính là cái mà rất nhiều người không để ý đến. Các control vẽ lên sheet ngoài cái property chung còn có property riêng của nó nữa. Chính những properties này mới là đặc thù của chính cái control, mà ai không biết sẽ không dùng hết tính năng hoặc cho rằng control không hoạt động.
Nhấp chuột vào đây để mở rộng...
Và đây cũng chính là vấn đề em muốn đố khi đề nghị cải tiến ImageCombo đặt trên UserForm. Vì Control trên UserForm lại chẳng có property riêng kiểu này.
Vậy phải.. làm sao?
Hi... Hi...
 
Upvote 0
anhtuan1066 đã viết:
Đâu có khó khăn thế! Class gì đó thì còn gì là ĐỐ VUI!
------------------------------------------------------------
- Bấm nút Design Mode
- Click phải vào ImageList1, chọn ImageList Ctrl Object\Properties
- Chuyển sang tab Images sẽ thấy ngay cách Insert Picture
------------------------------------------------------------
Nếu đã nghiên cứu và hiểu rõ cách làm trên file này, các bạn hãy cải tiến sao cho có thể dùng được ImageCombo trên UserForm nhé
(Lưu ý: Áp dụng y chang như file đã gữi)
Nhấp chuột vào đây để mở rộng...

Hay thật, vậy từ nay đã có cái để "chơi" rồi! Thế muốn từ cái ImageCombo rồi chuyển cái hình ra ngoài sheet thì phải làm sao hả Thầy AnhTuan?
 
Upvote 0
minhthien321 đã viết:
Hay thật, vậy từ nay đã có cái để "chơi" rồi! Thế muốn từ cái ImageCombo rồi chuyển cái hình ra ngoài sheet thì phải làm sao hả Thầy AnhTuan?
Nhấp chuột vào đây để mở rộng...

Tôi chỉ biết được có vầy:
PHP: 
Private Sub ImageCombo1_Click()
  ImageCombo1.CopyPicture 1, 1
  Range("A1").PasteSpecial
End Sub
Bạn thử xem rồi cải tiến tiếp
 
Upvote 0
ptm0412 đã viết:
Đã biết chơi 100% chưa? Dám cá minhthien không tạo thành công ngay lập tức 1 file mới bắt đầu từ zero.
Nhấp chuột vào đây để mở rộng...

Dạ, em bắt đầu từ Zero ạ! Hehehehe. Hồi mới sinh ra em có biết đi đâu, giờ em muốn vợ rồi Thầy ơi! Khahakkahaahk
 
Upvote 0
Làm thử đưa file lên mới biết. Cái này tự giác, chứ không ai kiểm tra được nhe. Thay hình rồi Save As thì trời biết.
 
Upvote 0
minhthien321 đã viết:
Dạ, em bắt đầu từ Zero ạ! Hehehehe. Hồi mới sinh ra em có biết đi đâu, giờ em muốn vợ rồi Thầy ơi! Khahakkahaahk
Nhấp chuột vào đây để mở rộng...
Nếu làm mới từ đầu thì mấu chốt quan trọng nằm ở đây:


untitled.JPG





(Chổ tôi đánh dấu đỏ)

----------------------------------------------------------------------------------
minhthien321 đã viết:
muốn từ cái ImageCombo rồi chuyển cái hình ra ngoài sheet thì phải làm sao hả Thầy AnhTuan?
Nhấp chuột vào đây để mở rộng...

Vừa nghĩ ra cách khác hay hơn cách CopyPicture nhiều (hình sẽ đẹp hơn)

Code:
PHP: 
Private Sub ImageCombo1_Click()
  Sheet1.Image1.Picture = Sheet1.ImageList1.ListImages.Item(ImageCombo1.SelectedItem.Index).Picture
End Sub
Trên sheet có chèn thêm 1 Image Control
 

File đính kèm

Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Chời chời, cái chỗ đánh dấu đỏ là cái chỗ lão chết tiệt căn cứ vào mà cá với minhthien đó. Hu hu!
Hihi, có thể minhthien đang đánh vật với nó mà chưa biết trên đời có cái đó đó.
 
Upvote 0
ptm0412 đã viết:
Chời chời, cái chỗ đánh dấu đỏ là cái chỗ lão chết tiệt căn cứ vào mà cá với minhthien đó. Hu hu!
Hihi, có thể minhthien đang đánh vật với nó mà chưa biết trên đời có cái đó đó.
Nhấp chuột vào đây để mở rộng...

Lúc xưa em sưu tầm được cái này:
Tạo hình vẽ trong combox
Khi ấy chỉ xài chứ thật sự chẳng hiểu gì
Giờ mang ra nghiên cứu và làm trên sheet mới thấy nó khác hoàn toàn so với trên UserForm... Em cũng đã "đánh vật" mất 1 tiếng đồng hồ mới tìm ra được chổ "đánh dấu đỏ" ở trên đấy sư phụ à!
Hi... Hi... Giờ thì có thể cải tiến "ngon lành" hơn cái thằng.. xưa nhiều
----------------------------------------------------------------------------
Các bạn hãy nghiên cứu file này trên UserForm xem! (hình phải được lấy từ ImageList)
 
Upvote 0
anhtuan1066 đã viết:
Lúc xưa em sưu tầm được cái này:
Tạo hình vẽ trong combox
Khi ấy chỉ xài chứ thật sự chẳng hiểu gì
Giờ mang ra nghiên cứu và làm trên sheet mới thấy nó khác hoàn toàn so với trên UserForm... Em cũng đã "đánh vật" mất 1 tiếng đồng hồ mới tìm ra được chổ "đánh dấu đỏ" ở trên đấy sư phụ à!
Hi... Hi... Giờ thì có thể cải tiến "ngon lành" hơn cái thằng.. xưa nhiều
----------------------------------------------------------------------------
Các bạn hãy nghiên cứu file này trên UserForm xem! (hình phải được lấy từ ImageList)
Nhấp chuột vào đây để mở rộng...

Em định từ cái Code độc đáo này của Thầy, em sẽ làm danh sách nhân viên và mỗi tên có một hình em add lên Form luôn cho sinh động.
Cám ơn Thầy!

Hic hic, Insert ảnh chụp nó chẳng có chịu cho, báo lỗi hoài! Hoặc ra cái combo trắng bóc!
 
Lần chỉnh sửa cuối:
Upvote 0
Làm trên form thì dùng ImageList ảo cũng được. Image thì insert trên form luôn. Chôm và cải tiến code trên file của đường link anhtuan giới thiệu.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hic hic, Insert ảnh chụp nó chẳng có chịu cho, báo lỗi hoài! Hoặc ra cái combo trắng bóc!
Nhấp chuột vào đây để mở rộng...

Chắc tại hình lớn quá chứ gì. Hình .jpg, size vừa vừa lên tuốt, cả trên sheet lẫn trên form.

Làm chơi thôi chứ làm thật vào DSNV mấy chục người thì file nặng đâu có chịu nổi.

PHP: 
Private Sub ImageCombo1_Click()
Me.Image8.Picture = Me.Controls("Image" & ImageCombo1.SelectedItem.Index).Picture
End Sub
PHP: 
Private Sub UserForm_Initialize()
    Dim imgLst As New ImageList
    Dim i As Long
    For i = 1 To 7
        imgLst.ListImages.Add i, "img" & i, Me.Controls("Image" & i).Object.Picture
    Next
    Set ImageCombo1.ImageList = imgLst
    For i = 1 To 7
        ImageCombo1.ComboItems.Add i, , , "img" & i, , 2
    Next
    Set imgLst = Nothing
End Sub

tải file
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Làm trên form thì dùng ImageList ảo cũng được. Image thì insert trên form luôn. Chôm và cải tiến code trên file của đường link anhtuan giới thiệu.
Nhấp chuột vào đây để mở rộng...

Không phải vậy sư phụ ơi! Vì nếu làm thế thì chẳng hóa ra giống y chang cái này sao: Tạo hình vẽ trong combox
Ý em là dùng 1 ImageList thật đàng hoàng và chèn hình vào đó (ImageList ấy có thể đặt trên form hay trên sheet tùy ý)
Vấn đề ở đây là ImageComboBox trên Form không có Properties riêng, vậy phải xử lý thế nào?
-------------------
Đố thêm:
Trên file cuối cùng của sư phụ, ta thấy rằng khi chọn vào ImageComboBox (trên Form) thì hình hiên ra không hết ---> Vậy phải chỉnh thế nào để có thể nhìn thấy toàn bộ hình?
 
Lần chỉnh sửa cuối:
Upvote 0
Mọi properties riêng hay chung đều có thể dùng VBA để set cả. Tra cứu properties bằng object browser là ra tuốt luốt.
Trên file cuối cùng của sư phụ, ta thấy rằng khi chọn vào ImageComboBox (trên Form) thì hình hiên ra không hết ---> Vậy phải chỉnh thế nào để có thể nhìn thấy toàn bộ hình?
Nhấp chuột vào đây để mở rộng...

Bờ i bi sắc bí!
 
Upvote 0
Câu 2: Sư phụ chỉnh font cho ImageComboBox = 150 thử xem!
Nhấp chuột vào đây để mở rộng...
Thương anhtuan nhất cái chỗ này: Ai bí cứ thừa nhận là bí, anhtuan sẽ dốc túi chỉ bảo tận tình. Ai biết thì thưa thốt, không biết chấp nhận dựa cột mà nghe, thì anhtuan nói cho nghe!
Spam 1 phát!
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Thương anhtuan nhất cái chỗ này: Ai bí cứ thừa nhận là bí, anhtuan sẽ dốc túi chỉ bảo tận tình. Ai biết thì thưa thốt, không biết chấp nhận dựa cột mà nghe, thì anhtuan nói cho nghe!
Spam 1 phát!
Nhấp chuột vào đây để mở rộng...
Học hỏi lẩn nhau mà sư phụ, vì có ai biết hết mọi vấn đề
Hi... Hi... Em cũng Spam theo 1 tí
-----------------------------------------
Em còn thắc mắc 1 vấn đề với ImageComboBox trên sheet (và nói chung tất cả các Control dạng này).. là dù ta có chỉnh kích thước cho nó = bao nhiêu thì khi lưu file rồi mở ra, nó vẫn trả về như củ! Là sao ta?
Thậm chí có đôi lúc còn không thể chỉnh kích thước cho nó to lên được
Sư phụ có ý kiến gì về vấn đề này không? (hỏng lẽ phải viết code trong sự kiện Workbook_Open để chỉnh sao?)
 
Lần chỉnh sửa cuối:
Upvote 0
Nạp list cho ComboBox không qua vòng lập

Nhân có bài viết này:
Liên kết các sheet thông qua combobox
Ở đó người ta nạp tên các sheet vào ComboBox thông qua 1 vòng lập (đương nhiên xưa nay vẫn vậy)
Xin mở thêm câu đố mới: Cũng với yêu cầu nạp tên các sheet vào 1 ComboBox, có cách nào không cần dùng đến vòng lập không?
(Nói chung là bất cứ cách gì miễn sao không phải là vòng lập. Cũng không dùng đến vùng phụ để tạo ListFillRange)
 
Upvote 0
anhtuan1066 đã viết:
Nhân có bài viết này:
Liên kết các sheet thông qua combobox
Ở đó người ta nạp tên các sheet vào ComboBox thông qua 1 vòng lập (đương nhiên xưa nay vẫn vậy)
Xin mở thêm câu đố mới: Cũng với yêu cầu nạp tên các sheet vào 1 ComboBox, có cách nào không cần dùng đến vòng lập không?
(Nói chung là bất cứ cách gì miễn sao không phải là vòng lập. Cũng không dùng đến vùng phụ để tạo ListFillRange)
Nhấp chuột vào đây để mở rộng...
Giả sử ComboBox có tên là cboSheets, viết sự kiện cho Sheet chứa ComboBox như sau, không rõ có đúng với yêu cầu của tác giả không.
Mã: 
Private Sub Worksheet_Activate()
    ThisWorkbook.Names.Add "AllSheetName", "=MID(GET.WORKBOOK(1+0*NOW()),FIND(""]"",GET.WORKBOOK(1+0*NOW()))+1,LEN(GET.WORKBOOK(1+0*NOW())))"
    cboSheets.Clear
    Dim arr
    arr = Evaluate("TRANSPOSE(""INDEX(AllSheetName,1,""&ROW(A1:A" & Sheets.Count & ")&"")"")")
    cboSheets.List = Split(Evaluate(Join(arr, "&""?""&")), "?")
    ThisWorkbook.Names("AllSheetName").Delete
End Sub
 
Upvote 0
Công nhận hay thiệt, tôi chưa bao giờ dùng dạng như vầy.
Tks rollover79.

Lê Văn Duyệt
 
Upvote 0
rollover79 đã viết:
Giả sử ComboBox có tên là cboSheets, viết sự kiện cho Sheet chứa ComboBox như sau, không rõ có đúng với yêu cầu của tác giả không.
Mã: 
Private Sub Worksheet_Activate()
ThisWorkbook.Names.Add "AllSheetName", "=MID(GET.WORKBOOK(1+0*NOW()),FIND(""]"",GET.WORKBOOK(1+0*NOW()))+1,LEN(GET.WORKBOOK(1+0*NOW())))"
cboSheets.Clear
Dim arr
arr = Evaluate("TRANSPOSE(""INDEX(AllSheetName,1,""&ROW(A1:A" & Sheets.Count & ")&"")"")")
cboSheets.List = Split(Evaluate(Join(arr, "&""?""&")), "?")
ThisWorkbook.Names("AllSheetName").Delete
End Sub
Nhấp chuột vào đây để mở rộng...
Công nhận giống đến 9/10 ý kiến của tôi!
Ý tôi là vầy:
PHP: 
Function GetSh()
  Dim Temp()
  ThisWorkbook.Names.Add String(240, "z"), "=SUBSTITUTE(GET.WORKBOOK(1),""[""&GET.WORKBOOK(16)&""]"","""")"
  Temp = Evaluate("Transpose(" & String(240, "z") & ")")
  Temp = WorksheetFunction.Transpose(Temp)
  ThisWorkbook.Names(String(240, "z")).Delete
  GetSh = Temp
End Function
PHP: 
Private Sub ComboBox1_DropButtonClick()
  If ComboBox1.ListCount = 0 Then ComboBox1.List() = GetSh
End Sub
(Tôi nghĩ không cần đến NOW() làm gì, đàng nào ta cũng xóa name sau khi hoàn tất)
Cảm ơn rollover79 nhé, bạn luôn có những ý tưởng đáng để tôi học hỏi thêm
 

File đính kèm

Upvote 0
Tạo nhiều Buttons cùng 1 lúc

Có tình huống thế này:
- Tôi vẽ 1 Buttons nằm gọn trong cell A1 (Buttons này thuộc thanh Forms)
- Chọn cell A1 và bấm Ctrl + C
- Quét chọn A2:A10 và bấm Ctrl + V
Với 3 bước thao tác tôi đã tạo được 10 Buttons
Và cho dù có tạo ra 100 Buttons hay nhiều hơn nữa, tôi cũng chỉ cần 3 thao tác (như trên)
Vậy xin hỏi các bạn: Chúng ta viết code thực hiện quá trình trên như thế nào?
(Thử record macro xem, nhưng e rằng khi xem xong code record sẽ làm các bạn thất vọng)
-------------------------------------------------------------------------------
Nếu viết được code vẽ 10 Buttons trên 1 sheet thì tôi nghĩ việc này cũng có thể thực hiện trên nhiều sheet trong cùng 1 lúc đấy nhỉ? Hi... Hi...
 
Upvote 0
anhtuan1066 đã viết:
Có tình huống thế này:
- Tôi vẽ 1 Buttons nằm gọn trong cell A1 (Buttons này thuộc thanh Forms)
- Chọn cell A1 và bấm Ctrl + C
- Quét chọn A2:A10 và bấm Ctrl + V
Với 3 bước thao tác tôi đã tạo được 10 Buttons
Và cho dù có tạo ra 100 Buttons hay nhiều hơn nữa, tôi cũng chỉ cần 3 thao tác (như trên)
Vậy xin hỏi các bạn: Chúng ta viết code thực hiện quá trình trên như thế nào?
(Thử record macro xem, nhưng e rằng khi xem xong code record sẽ làm các bạn thất vọng)
-------------------------------------------------------------------------------
Nếu viết được code vẽ 10 Buttons trên 1 sheet thì tôi nghĩ việc này cũng có thể thực hiện trên nhiều sheet trong cùng 1 lúc đấy nhỉ? Hi... Hi...
Nhấp chuột vào đây để mở rộng...
Vẽ nhiều button trên 1 sheet thì không vấn đề gì, nhưng không rõ yêu cầu còn có ràng buộc gì đặc biệt không???
 
Upvote 0
Kẻ khung (Border) cho 1 vùng

Trước tiên các bạn hãy xem qua topic này: Code về Borders
Ở đây người ta đã giải quyết vấn đề kẻ khung thông qua vòng lập!
Đố các bạn biết: Còn cách nào khác có thể kẻ khung cho 1 vùng mà không cần vòng lập không?
(Không tính đến SendKeys)
-----------------------------------------------------------------------------------------------------------------------
Hỏi cả 1 đóng nhưng chẳng thấy ai tham gia dù chỉ là thắc mắc... Hic...
Xin thưa với các bạn rằng Excel vẫn còn rất nhiều.. rất nhiều thứ ta chưa biết lắm.. và nó có khà năng làm được nhiều hơn ta tưởng đấy
(Ngày nào tôi cũng nghiên cứu và luôn phát hiện ra nhiều điều mới lạ)
 
Upvote 0
rollover79 đã viết:
"Cùng lúc" theo tôi hiều là không dùng vòng lặp, không rõ có đúng không???
Nhấp chuột vào đây để mở rộng...
Như tôi đã nói ở bài #280, tôi làm bằng tay chỉ 3 thao tác là có thể tạo ra bao nhiêu Buttons tùy ý... Tương tự như thế cho bài tạo Border, chỉ 1 thao tác bằng tay là tôi có thể kẻ khung cho toàn bộ các cell của vùng chọn... Vậy lý nào viết code lại phải cần đến vòng lập?
Bạn biểu diển xem! Tôi cũng rất muốn học hỏi!
 
Upvote 0
anhtuan1066 đã viết:
Như tôi đã nói ở bài #280, tôi làm bằng tay chỉ 3 thao tác là có thể tạo ra bao nhiêu Buttons tùy ý... Tương tự như thế cho bài tạo Border, chỉ 1 thao tác bằng tay là tôi có thể kẻ khung cho toàn bộ các cell của vùng chọn... Vậy lý nào viết code lại phải cần đến vòng lập?
Bạn biểu diển xem! Tôi cũng rất muốn học hỏi!
Nhấp chuột vào đây để mở rộng...
Code sau sẽ tạo danh sách buttons, nhưng mấu chốt ở đây là phải có lựa chọn Cut, copy, and sort objects with cells trong tuỳ chỉnh của excel, nếu không thì thao tác thực hiện bằng tay cũng không được.
Mã: 
Sub CreateButtons()
    ActiveSheet.Shapes.AddFormControl xlButtonControl, [A1].Left, [A1].Top, [A1].Width, [A1].Height
    Range("A1").Copy [A2:A10]
End Sub
 
Upvote 0
rollover79 đã viết:
Code sau sẽ tạo danh sách buttons, nhưng mấu chốt ở đây là phải có lựa chọn Cut, copy, and sort objects with cells trong tuỳ chỉnh của excel, nếu không thì thao tác thực hiện bằng tay cũng không được.
Mã: 
Sub CreateButtons()
ActiveSheet.Shapes.AddFormControl xlButtonControl, [A1].Left, [A1].Top, [A1].Width, [A1].Height
Range("A1").Copy [A2:A10]
End Sub
Nhấp chuột vào đây để mở rộng...
Chính xác như tôi đã làm:
PHP: 
Sub Draw10Buttons()
  With Range("A1")
    .Parent.Buttons.Add .Left, .Top, .Width, .Height
    .AutoFill Range("A1:A10")
  End With
End Sub
Vậy mời bạn tiếp bài Border nhé
Tôi còn hơn 1 tá câu hỏi nữa nhưng cũng hơi buồn vì chỉ thấy mổi mình bạn tham gia... chẳng han:
- Có thể lấy toàn bộ tên file trong 1 thư mục nào đó (không tính thư mục con) mà không cần đến vòng lập hay không?
- Có thể lấy toàn bộ tên của các Workbooks đang mở mà không cần đến vòng lập hay không?
- Từ 1 file text (txt) chứa nội dung code VBA, có thể import code này vào cửa sổ VBA của workbook hiện hành hay không?
vân vân..
 
Lần chỉnh sửa cuối:
Upvote 0
anhtuan1066 đã viết:
Chính xác như tôi đã làm:
PHP: 
Sub Draw10Buttons()
  With Range("A1")
    .Parent.Buttons.Add .Left, .Top, .Width, .Height
    .AutoFill Range("A1:A10")
  End With
End Sub
Vậy mời bạn tiếp bài Border nhé
Tôi còn hơn 1 tá câu hỏi nữa nhưng cũng hơi buồn vì chỉ thấy mổi mình bạn tham gia... chẳng han:
- Có thể lấy toàn bộ tên file trong 1 thư mục nào đó (không tính thư mục con) mà không cần đến vòng lập hay không?
- Có thể lấy toàn bộ tên của các Workbooks đang mở mà không cần đến vòng lập hay không?
- Từ 1 file text (txt) chứa nội dung code VBA, có thể import code này vào cửa sổ VBA của workbook hiện hành hay không?
vân vân..
Nhấp chuột vào đây để mở rộng...
Đoạn code sau sẽ vẽ Border cho vùng A1:B6, tuy nhiên code này còn rất nhiều hạn chế, dù sao nó cũng không cần dùng vòng lặp :), không rõ có giống ý tưởng của tác giả hay không.
Mã: 
Sub DrawBoders()
    Dim arr
    ThisWorkbook.Names.Add "rng", "=TRANSPOSE(ADDRESS(INT((ROW(Sheet1!$1:$20)-1)/2+1),MOD((ROW(Sheet1!$1:$20)-1),2)+1))"
    arr = Evaluate("TRANSPOSE(""INDEX(rng,1,""&ROW(A1:A12)&"")"")")
    Range(Evaluate(Join(arr, "&"",""&"))).BorderAround xlSolid, xlThin, xlColorIndexAutomatic, vbBlack
    ThisWorkbook.Names("rng").Delete
End Sub
Code này sẽ đơn giản hơn chút, vẽ borders cho vùng được chọn, tư tưởng vẫn vậy, nhưng vẫn còn hạn chế
Mã: 
Sub DrawBoders()
    Dim rng As Range
    Set rng = Selection
    
    Dim iRowRop As Integer
    Dim iRows As Integer
    Dim iColLeft As Integer
    Dim iCols As Integer
    iRowRop = rng.Row
    iRows = rng.Rows.Count
    iColLeft = rng.Column
    iCols = rng.Columns.Count
    
    Range(Join(Evaluate("TRANSPOSE(ADDRESS(INT((ROW(1:" & iRows * iCols & ")-1)/" & iCols & "+" & iRowRop & "),MOD((ROW(1:" & iRows * iCols & ")-1)," & iCols & ")+" & iColLeft & "))"), ",")).BorderAround xlSolid, xlThin, xlColorIndexAutomatic, vbBlack
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mấy hôm tìm cái BorderAll mà không ra, té ra là BorderAround. Hướng là vầy:
- BorderAround 1 cell (cell đầu tiên trong vùng chọn)
- Copy paste special Formats cho các cell còn lại.
 
Upvote 0
ptm0412 đã viết:
Mấy hôm tìm cái BorderAll mà không ra, té ra là BorderAround. Hướng là vầy:
- BorderAround 1 cell (cell đầu tiên trong vùng chọn)
- Copy paste special Formats cho các cell còn lại.
Nhấp chuột vào đây để mở rộng...
Cách này tôi có nghĩ qua, nhưng không ổn, paste Format là nó paste toàn bộ định dạng chứ đâu có paste riêng border đâu, người ta chỉ muốn kẻ khung mà đi thay đổi cả các định dạng khác(chữ đậm, nghiêng, màu nền, ...) thì sao chấp nhận đc.
 
Upvote 0
Thật ra có 1 cách rất đơn giản nếu chúng ta biết rằng macro 4 có hàm này:
PHP: 
BORDER(outline, left, right, top, bottom, shade, outline_color, left_color, right_color, top_color, bottom_color)
Vậy ta viết như sau:
PHP: 
Sub BorderAll()
  Dim K As Long
  K = 1
  ExecuteExcel4Macro ("BORDER(" & K & "," & K & "," & K & "," & K & "," & K & ")")
End Sub
- Chọn vùng rồi chạy code sẽ ra được kết quả như ý
- Thay K từ 0 đến 13 để xem thay đổi
- Còn các tham số phía sau cho phép tô màu khung nữa đấy
-------------------------------------------------------------------
Hãy tham khảo các hàm macro 4 khác để giải các câu hỏi còn lại (rất dể dàng)
- Hàm FILES trả về 1 Array với các phần tử là tên của tất cả các file trong 1 thư mục đã chỉ định
- Hàm DOCUMENTS trả về 1 Array với các phần tử là tên của tất cả các Workbook đang mở
Vậy đâu cần phải For... Next
Riêng về phần import 1 file text chưa code VBA vào của sổ VBA của WB hiện hành, xin mời các bạn tự nghiên cứu. Còn rất nhiều món độc chiêu khác nữa đấy!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã: 
Workbooks("Book1.xls").Activate

Mã 2:
Mã: 
Workbooks("Book1").Activate

Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1. Xin chú ý, workbook này đã lưu.

(Tip: Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Upvote 0
levanduyet đã viết:
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã: 
Workbooks("Book1.xls").Activate

Mã 2:
Mã: 
Workbooks("Book1").Activate

Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1

(Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...
Cho em hỏi thêm là Book1 đó lưu file chưa?
Em nghĩ mã 2 đúng vì nó chạy tốt hơn. File lưu và chưa lưu ngay cả Office 2007 trở lên, còn code Mã 1 chỉ chạy cho những file đã lưu rồi và phiên bản từ Office 2003 trở xuống.
Không biết phải vậy không
 
Upvote 0
Hi domfootware,

Câu trả lời chưa đúng. Workbook book1 đã được lưu và đang mở cùng với một số workbook khác.

Lê Văn Duyệt
 
Upvote 0
levanduyet đã viết:
Vui tí, vui tí:

Trong hai đoạn mã sau, đoạn nào đúng, đoạn nào sai, tại sao?
Mã 1
Mã: 
Workbooks("Book1.xls").Activate
Mã 2:
Mã: 
Workbooks("Book1").Activate
Giả sử tôi đang mở nhiều workbook trong đó có workbook với tên: Book1. Xin chú ý, workbook này đã lưu.

(Tip: Lỗi số 9 "an error 9, Subscript Out Of Range" sẽ hiện ra)

Lê Văn Duyệt
Nhấp chuột vào đây để mở rộng...
Tôi chưa thử trên Excel 2007 nên không biết thế nào, còn riêng Excel 2003 thì đoạn code này: Workbooks("Book1").Activate chưa bao giờ chạy thành công nếu Book1 đã được lưu
Lúc nào xài thì tôi luôn dùng Workbooks("Book1.xls").Activate
Thí nghiệm: Đứng tại book1 và chạy đoạn code này:
PHP: 
Sub Test2()
 MsgBox ActiveWorkbook.Name
End Sub
Nó cho kết quả là book1.xls đấy nha (không phải là book1)
Nếu book1 chưa lưu thì thì đoạn code 1 chạy đúng và ngược lại
(có vẽ như khi ta chưa lưu file thì Excel chưa thể xác định đuôi file ấy là gì nên chỉ cần gọi tên là được)
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Tôi chưa thử trên Excel 2007 nên không biết thế nào, còn riêng Excel 2003 thì đoạn code này: Workbooks("Book1").Activate chưa bao giờ chạy thành công nếu Book1 đã được lưu
Nhấp chuột vào đây để mở rộng...

Anh hãy thử chỉnh chức năng này của Window Explorer:

folderoption.jpg


Rồi anh thử hai đoạn mã ở trên. Chắc chắn rẳng sẽ có một đoạn mã báo lỗi như sau:

runtimeerror9.jpg


Tùy theo từng trường hợp thiết lập Hide extensions for know file type (hi hi hi, như vậy mới rơi vào bẫy của em chứ)

Anh thử xong rồi ta lại tiếp tục bàn luận.

Lê Văn Duyệt
 
Lần chỉnh sửa cuối:
Upvote 0
Tổng hợp dữ liệu từ các file trong 1 thư mục (Consolidate)

Chắc các bạn đều biết công cụ Consolidate, nó có khả năng tổng hợp dữ liệu từ nhiều sheet, thậm chí từ nhiều file
Việc viết code có thể dựa trên cơ sơ Record macro rồi chỉnh lại
Vấn đề ở đây là tôi có 4 file nằm trong 1 thư mục, tôi muốn dùng Consolidate để tổng hợp nó ra 1 file khác mà không cần đến 1 vòng lập nào
Các bạn hãy thử xem
Có file đính kèm, ra kết quả giống như trong file ConsolMutiFiles.xls là xem như thành công! (các file con nằm trong thư mục Source)
Lưu ý:
- Ta chỉ biết các file con nằm trong 1 thư mục chỉ định trước chứ không biết có tổng cộng bao nhiêu file con và tên file con là gì đâu nha
- Biết trước: các file con nằm trong thư mục Source (là thư mục con của thư mục chứa file ConsolMutiFiles.xls)
- Biết trước: Dữ liệu cần tổng hợp trong các file con nằm ở "Sheet1", vùng "A2:B30"
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
anhtuan1066 đã viết:
Thật ra có 1 cách rất đơn giản nếu chúng ta biết rằng macro 4 có hàm này:
PHP: 
BORDER(outline, left, right, top, bottom, shade, outline_color, left_color, right_color, top_color, bottom_color)
Vậy ta viết như sau:
PHP: 
Sub BorderAll()
  Dim K As Long
  K = 1
  ExecuteExcel4Macro ("BORDER(" & K & "," & K & "," & K & "," & K & "," & K & ")")
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn ndu nhiều, vậy có UDF noBorder không. Làm giúp 1 cái.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

M
  • Question Question
[Hỏi cách tạo VBA] - Xin các cao nhân chỉ giúp cách tạo VBA cho công việc thuận tiện hơn
Trả lời
2
Đọc
31
manhcuonghg
M
S
cần xử lý dữ liệu trùng nhau bằng VBA (1 người xem)
    • Cười
Trả lời
6
Đọc
129
sonminhtran
S
N
Tạo file lưu trữ dữ liệu tự động trên excel. (1 người xem)
Trả lời
10
Đọc
149
nguyenle01
N
D
lọc các ô trong một cột chứa một nhóm dữ liệu? mong các cao thủ giải đáp giúp mình (1 người xem)
Trả lời
3
Đọc
43
Gà Con yêu VBA
Gà Con yêu VBA
N
  • Question Question
Tạo file lưu trữ dự liệu tự động
Trả lời
7
Đọc
156
nguyenle01
N
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
7
Đọc
314
Gà Con yêu VBA
Gà Con yêu VBA
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
518
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
3
Đọc
140
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ (1 người xem)
Trả lời
4
Đọc
103
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
83
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
81
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro (1 người xem)
Trả lời
14
Đọc
620
Quang_Hải
Quang_Hải
Xem thêm…

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

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom