Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình) (2 người xem)

tuananhya2 · 17/1/13

Co ai chỉ dùm cách tạo pass marco với

app · 17/1/13

Trong cửa sổ VBA Editor, vào menu Tools>VBAProject Properties.
Hiện lên 1 cái cửa sổ, chọn tiếp tab Proctection:

Chọn Lock Project for viewing.
Đánh 2 ô password ở dưới (Password/Confirm). Nhấn Ok, tò mò thì nhấn Help.

Sau khi đóng file và mở file lại thì mới có hiệu lực. Muốn xem Code thì nhấn vào cây Project bên tay trái.
Tính post hình minh họa mà nản với mấy cái hình thumbnail wa.

VMH0307 · 17/1/13

tuananhya2 đã viết:
Co ai chỉ dùm cách tạo pass marco với

Câu hỏi của bạn chung chung quá, nếu là VBA thì theo như bài #2
Còn nếu bạn hỏi về macro4 như nội dung của Box này thì macro sheet xử lý giống như một sheet bảng tính bình thường (có protect, có hide, unhide)

Quang_Hải · 17/1/13

tuananhya2 đã viết:
Co ai chỉ dùm cách tạo pass marco với

Chưa am hiểu nhiều về code thì tạo pass làm gì hả bạn. Tính giấu nghề hả? Có tạo pass xong thì chỉ cần 3 giây là phá được rồi.

ndu96081631 · 18/1/13

Nhận thấy các thành viên mới học VBA thường hay hỏi những câu đơn giản liên quan đến việc xử lý code.. vân vân... và các bạn đã mở nhiều topic đến mức không còn quản lý được
Hôm nay tôi lập topic này. Các bạn, những ai mới học lập trình nếu có câu hỏi về macro (thuộc dạng đơn giản) vui lòng gửi bài vào đây nhé!
Cảm ơn!
ANH TUẤN

gakon_Office · 2/2/13

Hỏi về code tự động mở khóa password Open của file để links dữ liệu!

Xin chào mọi người!
Em đang làm một file tổng hợp dữ liệu links từ các file con..
Nhưng các file con này đều đặt password open file.. do vậy mỗi lần em bấm nút "Update" là nó hiện lên cửa sổ đòi nhập pass và em phải mất công nhập pass nhiều lần. Nếu nhập sai pass coi như cả đoạn code cũng bị lỗi.

Do vậy em muốn hỏi là có cách nào thực hiện mở pass Open file = code được không.

Ví dụ:em để code update trong file tổng hợp
Em muốn links dữ liệu từ file A có pass là 123 và file B có pass là 456 vậy em phải viết code cho đoạn này thế nào để nó không đòi nhập pass khi mình thực hiện lệnh update nữa..

Mong được giúp đỡ.
Xin cám ơn!

Hong.Van · 2/2/13

gakon_Office đã viết:
Xin chào mọi người!
Em đang làm một file tổng hợp dữ liệu links từ các file con..
Nhưng các file con này đều đặt password open file.. do vậy mỗi lần em bấm nút "Update" là nó hiện lên cửa sổ đòi nhập pass và em phải mất công nhập pass nhiều lần. Nếu nhập sai pass coi như cả đoạn code cũng bị lỗi.

Do vậy em muốn hỏi là có cách nào thực hiện mở pass Open file = code được không.

Ví dụ:em để code update trong file tổng hợp
Em muốn links dữ liệu từ file A có pass là 123 và file B có pass là 456 vậy em phải viết code cho đoạn này thế nào để nó không đòi nhập pass khi mình thực hiện lệnh update nữa..

Mong được giúp đỡ.
Xin cám ơn!

Có thể bài này giúp được bạn!
http://www.giaiphapexcel.com/forum/showthread.php?71093-Tự-động-nhập-password-khi-mở-file-excel

gakon_Office · 2/2/13

Rất cám ơn! Em sẽ tìm hiểu..
Nhưng em vẫn mong có thêm sự trợ giúp cụ thể cho bài viết trên.

Quang_Hải · 3/2/13

gakon_Office đã viết:
Rất cám ơn! Em sẽ tìm hiểu..
Nhưng em vẫn mong có thêm sự trợ giúp cụ thể cho bài viết trên.

Chắc đại loại là thế này. Giả sử pass của bạn là 123456789

PHP:

Sub mo_file()
Dim pass
pass = Application.InputBox("Nhap Pass:")
If pass <> 123456789 Then Exit Sub
Workbooks.Open duongdantenfile, , , , pass
End Sub

hoanglocphat · 3/2/13

Chào các bạn
Mình đang có khối từ ô D10 đến ô D30000, khối ô này là ngày tháng (định dạng theo kiểu dd/mm/yy) bây giờ trong khối cell này có lẫn một số ô không phải là ngày tháng (ví dụ: '03/02/12 hoặc abc, ....)
Bây giờ mình muốn các bạn giúp code để duyệt tất cả các ô trên, nếu ô nào kg phải là kiểu ngày tháng nói trên hoặc là test ... thì code sẽ tô ô bị lỗi màu đỏ! (nếu có bảng thông báo cell nào bị lỗi thì càng tốt)
Xin cảm ơn các bạn!

dhn46 · 3/2/13

hoanglocphat đã viết:
Chào các bạn
Mình đang có khối từ ô D10 đến ô D30000, khối ô này là ngày tháng (định dạng theo kiểu dd/mm/yy) bây giờ trong khối cell này có lẫn một số ô không phải là ngày tháng (ví dụ: '03/02/12 hoặc abc, ....)
Bây giờ mình muốn các bạn giúp code để duyệt tất cả các ô trên, nếu ô nào kg phải là kiểu ngày tháng nói trên hoặc là test ... thì code sẽ tô ô bị lỗi màu đỏ! (nếu có bảng thông báo cell nào bị lỗi thì càng tốt)
Xin cảm ơn các bạn!

Bạn dùng thử code này

Mã:

Sub Test()
Dim cls As Range
For Each cls In [D10:D3000]
    If Not IsDate(cls) Then
        cls.Interior.ColorIndex = 10
    End If
Next
End Sub

Quang_Hải · 3/2/13

dhn46 đã viết:
Bạn dùng thử code này

Mã:

Sub Test() Dim cls As Range For Each cls In [D10:D3000] If Not IsDate(cls) Then cls.Interior.ColorIndex = 10 End If Next End Sub

Hic 30 000 dòng mà chơi từng cell mình nghi là ngồi uống hết ly cafe cũng chưa xong.
Hay là mình đưa lên mảng xử nó thế này

PHP:

Sub test()
Dim dl(), i, Res As String
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If Not IsDate(dl(i, 1)) Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
End Sub

nhapmon · 3/2/13

hoanglocphat đã viết:
Chào các bạn
Mình đang có khối từ ô D10 đến ô D30000, khối ô này là ngày tháng (định dạng theo kiểu dd/mm/yy) bây giờ trong khối cell này có lẫn một số ô không phải là ngày tháng (ví dụ: '03/02/12 hoặc abc, ....)
Bây giờ mình muốn các bạn giúp code để duyệt tất cả các ô trên, nếu ô nào kg phải là kiểu ngày tháng nói trên hoặc là test ... thì code sẽ tô ô bị lỗi màu đỏ! (nếu có bảng thông báo cell nào bị lỗi thì càng tốt)
Xin cảm ơn các bạn!

code thì đã có các bậc lão thành làm rồi, mình thử làm bằng chức năng có sẳn của excel (nhân tiện chủ đề của bạn học thêm, excel 2010)
bước 1: bạn chọn vùng số liệu của bạn --->tab home--->format as table, chọn color bạn thích.
excel sẻ tự động đặt filter lọc ra các cell có format khác
bước2:chọn conditional formating --->Top/Button rule--->Top 10 items
nó sẻ lọc ra những cell có cùng formating

mình test hơn chục dòng thấy đúng, nhiều hơn nữa chưa thử.

Hong.Van · 4/2/13

quanghai1969 đã viết:
Hic 30 000 dòng mà chơi từng cell mình nghi là ngồi uống hết ly cafe cũng chưa xong.
Hay là mình đưa lên mảng xử nó thế này

PHP:

Sub test() Dim dl(), i, Res As String dl = Range([D10], [D65536].End(3)).Value For i = 1 To UBound(dl) If Not IsDate(dl(i, 1)) Then Res = Res & "," & "D" & i + 9 End If Next Res = Replace(Res, ",", "", 1, 1) Range(Res).Interior.ColorIndex = 6 End Sub

Code của anh, nếu ngày tháng có định dạng có dấu nháy đơn fía trước thì kg bị báo lỗi!
em cảm ơn

ndu96081631 · 4/2/13

Hong.Van đã viết:
Code của anh, nếu ngày tháng có định dạng có dấu nháy đơn fía trước thì kg bị báo lỗi!
em cảm ơn

Đương nhiên rồi, dùng IsDate sẽ không chính xác, nó không phân biệt được đâu là ngày thật sự và đâu là dạng Text có chứa ngày (cụ thể nó xem '03/02/12 cũng là Date luôn)
Có chăng nên dùng VarType để kiểm tra ---> If VarTye(Giá trị) <> 7 then

Quang_Hải · 4/2/13

ndu96081631 đã viết:
Đương nhiên rồi, dùng IsDate sẽ không chính xác, nó không phân biệt được đâu là ngày thật sự và đâu là dạng Text có chứa ngày (cụ thể nó xem '03/02/12 cũng là Date luôn)
Có chăng nên dùng VarType để kiểm tra ---> If VarTye(Giá trị) <> 7 then

Đúng là nhờ liều mạng viết code nên mới học được thêm cái hàm VarType. Lúc viết cũng biết là không đúng với yêu cầu nhưng mình nghĩ là sẽ có người phát hiện và cho ra giải pháp.
Cảm ơn anh NDU

aviaiva · 4/2/13

em viết một macro print, khi macro chạy thì nó hiện một form thông báo in (tự động) có cách nào không hiện thông báo gì mà in luôn không? giống như thêm câu như thêm application.screenupdate = false là màn hình nó không động đậy gì.

Quang_Hải · 4/2/13

aviaiva đã viết:
em viết một macro print, khi macro chạy thì nó hiện một form thông báo in (tự động) có cách nào không hiện thông báo gì mà in luôn không? giống như thêm câu như thêm application.screenupdate = false là màn hình nó không động đậy gì.

Nhưng sao bạn không cho mọi người xem code?

aviaiva · 4/2/13

quanghai1969 đã viết:
Nhưng sao bạn không cho mọi người xem code?

có gì mà phải xem hả bác
nếu cần thì đây ạ

PHP:

sub print_click()
' them gi vao day de khong hien thong bao in
selection.printout from:=1,to:=1;copies :=1
' cap nhat lai trang thai cu
end sub

Quang_Hải · 4/2/13

aviaiva đã viết:
có gì mà phải xem hả bác
nếu cần thì đây ạ

PHP:

sub print_click() ' them gi vao day de khong hien thong bao in selection.printout from:=1,to:=1;copies :=1 ' cap nhat lai trang thai cu end sub

Theo mình thì câu lệnh trên đã in ra rồi, không có cài gì để hiện thông báo lên màn hình cả.
Kiên nhẫn đợi câu trả lời khác xem sao.

aviaiva · 4/2/13

quanghai1969 đã viết:
Theo mình thì câu lệnh trên đã in ra rồi, không có cài gì để hiện thông báo lên màn hình cả.
Kiên nhẫn đợi câu trả lời khác xem sao.

khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

ndu96081631 · 4/2/13

aviaiva đã viết:
khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

Cái thông báo ấy có vướng bận gì đâu mà bạn cần phải tắt nó không biết
tuy nhiên, có thể xem bài này:
http://www.mrexcel.com/forum/excel-..."now-printing"-visual-basic-applications.html
Tắt bằng các hàm API

Quang_Hải · 4/2/13

aviaiva đã viết:
khi bắt đầu in nó hiện thông báo như sau (hình đính kèm)

em nghĩ có lẽ có một câu lệnh nào đó không cập nhật thông báo này dạng

[GPECODE=vb]application.(gì đó) = false[/GPECODE]

nhưng mà em không biết, em đã thử application.displayalert = false nhưng không được

Làm thì chắc là được nhưng hơi vất vả nghen. Mình có xem qua đường link anh NDU giới thiệu nhưng thấy có vẻ không cần thiết phải cực khổ như thế. Để dành thời gian suy nghĩ cái cần hơn trước cái đã.

Hong.Van · 4/2/13

hoanglocphat đã viết:
Chào các bạn
Mình đang có khối từ ô D10 đến ô D30000, khối ô này là ngày tháng (định dạng theo kiểu dd/mm/yy) bây giờ trong khối cell này có lẫn một số ô không phải là ngày tháng (ví dụ: '03/02/12 hoặc abc, ....)
Bây giờ mình muốn các bạn giúp code để duyệt tất cả các ô trên, nếu ô nào kg phải là kiểu ngày tháng nói trên hoặc là test ... thì code sẽ tô ô bị lỗi màu đỏ! (nếu có bảng thông báo cell nào bị lỗi thì càng tốt)
Xin cảm ơn các bạn!

Bạn thử với code này xem sao!
Cell bị lỗi nhiều thì bấm mỏi tay! Khuyến mãi luôn MsgBox tiếng Việt có dấu của Thầy Ndu
---------------
Các Thầy cô cho em hỏi làm sao để gom tất cả các Cell bị lỗi để thể hiện trong MsgBox 1 lần?
Em cảm ơn!

Mã:

Sub Format_ColumnD()
Dim i, Arr(), Text As String
    [D10:D10000].Font.ColorIndex = 1
    Text = "Bi5 lo64i cell "
    Arr = Range([D10], [D65536].End(4))
    For i = 1 To UBound(Arr)
        If Arr(i, 1) <> "" Then
            If VarType(Arr(i, 1)) <> 7 Then
                Cells(i + 9, 4).Font.ColorIndex = 3
                CreateObject("WScript.Shell").Popup UniConvert(Text, "VNI") & Cells(i + 9, 4).Address, , "THÔNG BÁO by H.V", vbOKOnly
            End If: End If
    Next
End Sub

Quang_Hải · 4/2/13

Hong.Van đã viết:
Bạn thử với code này xem sao!
Cell bị lỗi nhiều thì bấm mỏi tay! Khuyến mãi luôn MsgBox tiếng Việt có dấu của Thầy Ndu
---------------
Các Thầy cô cho em hỏi làm sao để gom tất cả các Cell bị lỗi để thể hiện trong MsgBox 1 lần?
Em cảm ơn!

Mã:

Sub Format_ColumnD() Dim i, Arr(), Text As String [D10:D10000].Font.ColorIndex = 1 Text = "Bi5 lo64i cell " Arr = Range([D10], [D65536].End(4)) For i = 1 To UBound(Arr) If Arr(i, 1) <> "" Then If VarType(Arr(i, 1)) <> 7 Then Cells(i + 9, 4).Font.ColorIndex = 3 CreateObject("WScript.Shell").Popup UniConvert(Text, "VNI") & Cells(i + 9, 4).Address, , "THÔNG BÁO by H.V", vbOKOnly End If: End If Next End Sub

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Hong.Van · 4/2/13

quanghai1969 đã viết:

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Quang_Hải · 4/2/13

Hong.Van đã viết:
Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Khi mình nối các chuỗi lại với nhau thì lòi ra cái dấu "," phía trước. Cho nên phải dùng Replace để khử nó thôi mà

...Và hàm Replace còn 1 tham số nữa mà chúng ta ít dùng

PHP:

Sub Replace_Function()
Dim str As String
str = "Lap Trinh VBA Vba Trong Excel"
MsgBox Replace(str, "VBA", "")
MsgBox Replace(str, "VBA", "", , , 1)
End Sub

ndu96081631 · 4/2/13

Hong.Van đã viết:
Em còn đang mơ hồ cái này?

Mã:

Res = Replace(Res, ",", "", 1, 1)

Mục đích làm gì vậy anh ? nhờ anh giải thích, em cảm ơn!

Bạn có thể thí nghiệm để biết "nó" là gì
Thay dòng:
Res = Replace(Res, ",", "", 1, 1)
Bằng
MsgBox Res
Bạn sẽ thấy thằng Res thì dư 1 dấu phẩy ở đầu! Vậy phải bằng cách gì đó để loại bỏ dấu phẩy này, nếu không thì Range(Res) sẽ lỗi... và Replace là 1 trong các giải pháp (không thích thì có thể dùng Res = Mid(Res, 2) cũng chẳng có vấn đề gì)

hungpecc1 · 4/2/13

Mình có đoạn code như sau :

Mã:

Sub KTra()
    Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value
    For i = 1 To UBound(Tmparr, 1)
        Debug.Print Tmparr(i, 2)
    Next
End Sub

F5 báo lỗi Tmparr(i,2) <------ các anh chị trong GPE thích cho mình với

VetMini · 4/2/13

Có những trường hợp bắt lỗi ngày tháng không dễ dàng chỉ xét kiểu. Nếu nó thằng thừng là "abc" thì dễ nhưng nếu nó là 12345 thì bắt không được.
Khi bắt lỗi dữ liệu, người ta phải đặt ra giới hạn. Nếu đúng kiểu nhưng nằm ngoài giới hạn là bắt.
Tuy nhiên nếu dữ liệu sai mà vẫn nằm trong giới hạn thì có trời biết. Cái gì cũng có mức độ hợp lý của nó.

ndu96081631 · 4/2/13

quanghai1969 đã viết:

Phải vầy không?

PHP:

Sub to_mau()
Dim dl(), i, Res As String, text As String
text = "Bi5 lo64i ca1c cell na2y: "
dl = Range([D10], [D65536].End(3)).Value
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) <> 7 Then
      Res = Res & "," & "D" & i + 9
   End If
Next
Res = Replace(Res, ",", "", 1, 1)
Range(Res).Interior.ColorIndex = 6
CreateObject("WScript.Shell").Popup UniConvert(text, "VNI") & Res, , "THÔNG BÁO by H.V", vbOKOnly
End Sub

Phát hiện thêm 1 lỗi: Với dữ liệu khoảng 10,000 dòng thì phép nối chuổi bị phá sản ---> Trường hợp này cứ xử lý cell à chắc ăn nhất:

Mã:

Sub to_mau()
  Dim tmp, aData
  Dim i, lFirst As Long, n As Long, lR As Long
  With Range([D10], [D65536].End(3))
    .Font.ColorIndex = 0
    lFirst = .Row
    aData = .Value
  End With
  For i = 1 To UBound(aData)
    tmp = aData(i, 1)
    If VarType(tmp) <> 7 Then
      lR = i - 1 + lFirst
      Range("D" & lR).Font.ColorIndex = 3
    End If
  Next
  MsgBox "Done!"
End Sub

10,000 dòng cho tốc độ cũng rất nhanh

ndu96081631 · 4/2/13

hungpecc1 đã viết:
Mình có đoạn code như sau :

Mã:

Sub KTra() Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value For i = 1 To UBound(Tmparr, 1) Debug.Print Tmparr(i, 2) Next End Sub

F5 báo lỗi Tmparr(i,2) <------ các anh chị trong GPE thích cho mình với

Với dòng lệnh Tmparr = Union(Range("A1:A6"), Range("C1:C6")).Value
thì Tmparr cũng chỉ lấy được giá trị của Range("A1:A6"), còn Range("C1:C6") sẽ bị bỏ mất
Muốn vòng lập duyệt hết phải sửa thành:

Mã:

Sub KTra()
  Dim tmpArr, i As Long, rng As Range, rSub As Range
  Set rng = Union(Range("A1:A6"), Range("C1:C6"))
  For Each rSub In rng.[COLOR=#ff0000][B]Areas[/B][/COLOR]
    For i = 1 To rSub.Rows.Count
      Debug.Print rSub(i, 1)
    Next
  Next
End Sub

- Duyệt qua các vùng nhỏ trong vùng lớn
- Tiếp theo mới duyệt các giá trị trong vùng nhỏ

hungpecc1 · 4/2/13

cảm ơn anh ndu đã giúp

^^ biết thêm được thuộc tính areas

Hong.Van · 4/2/13

Trước đây em có đặt các công thức dưới đây trong C.F để tô màu:

PHP:

=MOD(RIGHT(C9;2)*1;3)=1

PHP:

=MOD(RIGHT(C9;2)*1;3)=2

PHP:

=MOD(RIGHT(C9;2)*1;3)=0

Bây giờ em viết code để thay thế C.F như sau

Mã:

Sub ToMau_C()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    [C9:C10000].Font.ColorIndex = 1
    [C9:C10000].Font.Bold = 0
    Set rng = Range([A9], [A65536].End(3)).Resize(, 37)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
        If Right(arrSrc(i, 3), 2) = "01" Or Right(arrSrc(i, 3), 2) = "04" Or Right(arrSrc(i, 3), 2) = "07" Or Right(arrSrc(i, 3), 2) = "10" Then
            rng(i, 3).Font.ColorIndex = 5
            
        End If
        If Right(arrSrc(i, 3), 2) = "02" Or Right(arrSrc(i, 3), 2) = "05" Or Right(arrSrc(i, 3), 2) = "08" Or Right(arrSrc(i, 3), 2) = "11" Then
            rng(i, 3).Font.ColorIndex = 13
            
        End If
        If Right(arrSrc(i, 3), 2) = "03" Or Right(arrSrc(i, 3), 2) = "06" Or Right(arrSrc(i, 3), 2) = "09" Or Right(arrSrc(i, 3), 2) = "12" Then
            rng(i, 3).Font.ColorIndex = 10
            
        End If
    Next i
End Sub

----------------
1/ Em muốn thử đưa 3 cthức nói trên vào code nhưng chưa biết bằng cách nào? và nếu đưa vào thì nó có nhanh hơn code dưới không?
2/ Em thấy code trên hơi dài dòng và chậm? có cách nào cải tiến cho nó nhanh hơn không?
Em cảm ơn!
--------
P/s: trong code em có Resize(, 37), mục đích em đang tính cho toàn bảng tính!!

hungpecc1 · 4/2/13

Hong.Van đã viết:
Trước đây em có đặt các công thức dưới đây trong C.F để tô màu:

PHP:

=MOD(RIGHT(C9;2)*1;3)=1

PHP:

=MOD(RIGHT(C9;2)*1;3)=2

PHP:

=MOD(RIGHT(C9;2)*1;3)=0

1/ Em muốn thử đưa 3 cthức nói trên vào code nhưng chưa biết bằng cách nào? và nếu đưa vào thì nó có nhanh hơn code dưới không?
2/ Em thấy code trên hơi dài dòng và chậm? có cách nào cải tiến cho nó nhanh hơn không?
Em cảm ơn!
--------
P/s: trong code em có Resize(, 37), mục đích em đang tính cho toàn bảng tính!!

Không hiểu ý bạn thế nào : --> nhưng nếu là mình , mình sẽ thử viết theo cách này ( chưa test, nên hổng biết có ok không )

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CFval As Integer
If Target.Count = 1 And Intersect(Target, [C:C]) Is Nothing Then    
          CFval = Val(Right(Range("C" & Target.Row & ""), 2)) Mod 3    
          Select Case CFval        
            Case 0         
                   Target.Font.ColorIndex = 3       
            Case 1            
                   Target.Font.ColorIndex = 5        
            Case 2            
                  Target.Font.ColorIndex = 10    
          End Select
End If
End Sub

dhn46 · 4/2/13

hungpecc1 đã viết:
Không hiểu ý bạn thế nào : --> nhưng nếu là mình , mình sẽ thử viết theo cách này ( chưa test, nên hổng biết có ok không )

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) Dim CFval As Integer If Target.Count = 1 And Intersect(Target, [C:C]) Is Nothing Then CFval = Val(Right(Range("C" & Target.Row & ""), 2)) Mod 3 Select Case CFval Case 0 Target.Font.ColorIndex = 3 Case 1 Target.Font.ColorIndex = 5 Case 2 Target.Font.ColorIndex = 10 End Select End If End Sub

Chưa Test nên không Ok là đúng rồi bạn
1 - Đoạn

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Có nghĩa nếu Target là Nothing => Khi thay đổi tại cột C thì vô tác dụng
2- Đoạn

Mã:

...Right(Range("C" & Target.Row & ""), 2))....

Cái này đúng với T10, T11, T12 còn từ T1>T9 thì hổng có đúng
Mặt khác Target là 1 Range rồi thì chắc không cần Range nữa.
Vậy tôi tạm sửa thế này:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim CFval As Integer
If Target.Count = 1 And Not Intersect(Target, [C:C]) Is Nothing Then
          CFval = Val(Mid(Target, 2)) Mod 3
          Select Case CFval
            Case 0
                   Target.Font.ColorIndex = 3
            Case 1
                   Target.Font.ColorIndex = 5
            Case 2
                  Target.Font.ColorIndex = 10
          End Select
End If
End Sub

Hong.Van có thể tùy biến cho dữ liệu của mình

hungpecc1 · 5/2/13

dhn46 đã viết:
Chưa Test nên không Ok là đúng rồi bạn
1 - Đoạn

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Có nghĩa nếu Target là Nothing => Khi thay đổi tại cột C thì vô tác dụng
................
[/code]
Hong.Van có thể tùy biến cho dữ liệu của mình

^^ cái này thì còn phải tuỳ theo ý đồ của bạn Hồng Vân :
* Vì mình không hiểu điều kiện CF của bạn là tại cột C, hay là tại các ô bất kỳ so với cột C

dhn46 · 5/2/13

hungpecc1 đã viết:
^^ cái này thì còn phải tuỳ theo ý đồ của bạn Hồng Vân :
* Vì mình không hiểu điều kiện CF của bạn là tại cột C, hay là tại các ô bất kỳ so với cột C

Đoạn:

Mã:

...And Intersect(Target, [C:C]) Is Nothing

Nếu bạn không thêm yếu tố Not thì có nghĩa: khi thay đổi giá trị tại cột C thì các lệnh sau if sẽ không thực hiện.

Quang_Hải · 5/2/13

ndu96081631 đã viết:
Phát hiện thêm 1 lỗi: Với dữ liệu khoảng 10,000 dòng thì phép nối chuổi bị phá sản ---> Trường hợp này cứ xử lý cell à chắc ăn nhất:

Mã:

Sub to_mau() Dim tmp, aData Dim i, lFirst As Long, n As Long, lR As Long With Range([D10], [D65536].End(3)) .Font.ColorIndex = 0 lFirst = .Row aData = .Value End With For i = 1 To UBound(aData) tmp = aData(i, 1) If VarType(tmp) <> 7 Then lR = i - 1 + lFirst Range("D" & lR).Font.ColorIndex = 3 End If Next MsgBox "Done!" End Sub

10,000 dòng cho tốc độ cũng rất nhanh

Qua bài này phát hiện ra 1 điều là phương thức Range nếu vượt quá 64 đối số thì phá sản (Office 2010)
Nên mình đành dùng phương án mượn thêm 1 cột phụt tuy hơi rườm rà nhưng vẫn cho 1 tốc độ khá nhanh

PHP:

Sub to_mau2()
Dim dl(), i, Res()
[E10:E65536].ClearContents
dl = Range([D10], [D65536].End(3)).Resize(, 2).Value
ReDim Res(1 To UBound(dl), 1 To 1)
For i = 1 To UBound(dl)
   If VarType(dl(i, 1)) = 7 Then Res(i, 1) = 1
Next
[E10].Resize(i - 1, 1) = Res
Range([E10], [D65536].End(3).Offset(, 1)).SpecialCells(4).Offset(, -1).Interior.ColorIndex = 6
[E10:E65536].ClearContents
End Sub

ndu96081631 · 5/2/13

quanghai1969 đã viết:
Qua bài này phát hiện ra 1 điều là phương thức Range nếu vượt quá 64 đối số thì phá sản (Office 2010)
Nên mình đành dùng phương án mượn thêm 1 cột phụt tuy hơi rườm rà nhưng vẫn cho 1 tốc độ khá nhanh

PHP:

Sub to_mau2() Dim dl(), i, Res() [E10:E65536].ClearContents dl = Range([D10], [D65536].End(3)).Resize(, 2).Value ReDim Res(1 To UBound(dl), 1 To 1) For i = 1 To UBound(dl) If VarType(dl(i, 1)) = 7 Then Res(i, 1) = 1 Next [E10].Resize(i - 1, 1) = Res Range([E10], [D65536].End(3).Offset(, 1)).SpecialCells(4).Offset(, -1).Interior.ColorIndex = 6 [E10:E65536].ClearContents End Sub

SpecialCells cũng nên tránh đối với dữ liệu lớn
Nhớ có 1 lần (lâu lắm rồi) khi dùng SpecialCells, nó báo lỗi gì đó khi số lượng Area vượt quá giới hạn, cuối cùng chẳng tính toán được gì cả

Hong.Van · 5/2/13

Giúp sửa code kiểm tra Mã số thuế, nếu sai thì tô màu
------------------------------------------------------------------
Em muốn kiểm tra Mã số thuế ở cột G, nếu sai thì tô màu chữ, đúng thì kg tô màu!
Hàm Kiểm tra Mã số thuế

Mã:

Private Function MSTcheck(ByVal mst1) As Boolean
    Dim msttext, skt, mst As String
    If mst1 = "" Then
        msttext = msttext
    End If
    If Len(mst1 & "") = 13 Or Len(mst1 & "") = 14 Or Len(mst1 & "") = 10 Then
        mst = Mid(mst1, 1, 10)
        If IsNumeric(mst) Then
            msttext = mst
        Else
            Exit Function
        End If
        msttext = mst


        skt = CDbl(Mid(msttext, 1, 1)) * 31
        skt = skt + CDbl(Mid(msttext, 2, 1)) * 29
        skt = skt + CDbl(Mid(msttext, 3, 1)) * 23
        skt = skt + CDbl(Mid(msttext, 4, 1)) * 19
        skt = skt + CDbl(Mid(msttext, 5, 1)) * 17
        skt = skt + CDbl(Mid(msttext, 6, 1)) * 13
        skt = skt + CDbl(Mid(msttext, 7, 1)) * 7
        skt = skt + CDbl(Mid(msttext, 8, 1)) * 5
        skt = skt + CDbl(Mid(msttext, 9, 1)) * 3


        MSTcheck = (CDbl(Mid(msttext, 10)) = 10 - skt Mod 11)
    End If
End Function

Code để tô màu

Mã:

Sub ToMau_Cot_H()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    Dim bChk As Boolean
    [A18:O2000].Font.ColorIndex = 1
    [A18:O2000].Interior.ColorIndex = xlNone
    [A18:O2000].Font.Bold = 0
    Set rng = Range([A18], [A65536].End(3)).Resize(, 15)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
        If arrSrc(i, 1) <> "" Then
            bChk =[COLOR=#ff0000][B] MSTcheck[/B][/COLOR](CStr(arrSrc(i, 8)))
            If bChk = False Then rng(i, 8).Font.ColorIndex = 3
        End If
    Next i
End Sub

Code trên bị báo lỗi ở MSTcheck
và lỗi là " Compile error: Sub or fuction not difined "

Em sửa hòai mấy giờ rồi nhưng vẫn chưa được!
Thầy cô & anh chị giúp em!
Em cảm ơn!

kyo · 5/2/13

Hong.Van đã viết:

Giúp sửa code kiểm tra Mã số thuế, nếu sai thì tô màu
------------------------------------------------------------------
Em muốn kiểm tra Mã số thuế ở cột G, nếu sai thì tô màu chữ, đúng thì kg tô màu!
Hàm Kiểm tra Mã số thuế

Mã:

Private Function MSTcheck(ByVal mst1) As Boolean
    Dim msttext, skt, mst As String
    If mst1 = "" Then
        msttext = msttext
    End If
    If Len(mst1 & "") = 13 Or Len(mst1 & "") = 14 Or Len(mst1 & "") = 10 Then
        mst = Mid(mst1, 1, 10)
        If IsNumeric(mst) Then
            msttext = mst
        Else
            Exit Function
        End If
        msttext = mst


        skt = CDbl(Mid(msttext, 1, 1)) * 31
        skt = skt + CDbl(Mid(msttext, 2, 1)) * 29
        skt = skt + CDbl(Mid(msttext, 3, 1)) * 23
        skt = skt + CDbl(Mid(msttext, 4, 1)) * 19
        skt = skt + CDbl(Mid(msttext, 5, 1)) * 17
        skt = skt + CDbl(Mid(msttext, 6, 1)) * 13
        skt = skt + CDbl(Mid(msttext, 7, 1)) * 7
        skt = skt + CDbl(Mid(msttext, 8, 1)) * 5
        skt = skt + CDbl(Mid(msttext, 9, 1)) * 3


        MSTcheck = (CDbl(Mid(msttext, 10)) = 10 - skt Mod 11)
    End If
End Function

Code để tô màu

Mã:

Sub ToMau_Cot_H()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    Dim bChk As Boolean
    [A18:O2000].Font.ColorIndex = 1
    [A18:O2000].Interior.ColorIndex = xlNone
    [A18:O2000].Font.Bold = 0
    Set rng = Range([A18], [A65536].End(3)).Resize(, 15)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
        If arrSrc(i, 1) <> "" Then
            bChk =[COLOR=#ff0000][B] MSTcheck[/B][/COLOR](CStr(arrSrc(i, 8)))
            If bChk = False Then rng(i, 8).Font.ColorIndex = 3
        End If
    Next i
End Sub

Code trên bị báo lỗi ở MSTcheck
và lỗi là " Compile error: Sub or fuction not difined "

Em sửa hòai mấy giờ rồi nhưng vẫn chưa được!
Thầy cô & anh chị giúp em!
Em cảm ơn!

kyo chưa tính đến code bạn thế nào, nhưng lỗi của bạn có thể thấy được ở chỗ bạn để Private Function. Nếu bạn đặt Private Function ở 1 module, chạy Sub ToMau ở 1 module khác nữa thì nó sẽ dẫn đến lỗi, bởi vì Private chỉ có thể được sử dụng trong phạm vi module đó mà thôi. Để hết lỗi, bạn chỉ việc bỏ Private đi.

Hong.Van · 6/2/13

GIÚP SỬA CODE TÔ MÀU!
-------------------------------
Em có viết code tô màu cho cột E như sau:
Cột E này được phép nhập kiểu Number (ví dụ: 301) hoặc kiểu chuỗi, nhưng không được có ký tự là chữ lẫn lộn vào , ví dụ:
'0000301 -> OK
a301 -> không được
30ab1 ->không được
301dg -> không được
-----------
Code em như sau

Mã:

Sub TestMau_CotE()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    [A18:O2000].Font.ColorIndex = 1
    Set rng = Range([A18], [A65536].End(3)).Resize(, 15)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
        If Val(arrSrc(i, 5)) = False Then rng(i, 5).Font.ColorIndex = 3
    Next
End Sub

Nhưng trong File của em, cell E24 & E30 không bị tô màu?
Em không biết fải sửa Val thành cái gì?
Em cảm ơn!

ndu96081631 · 6/2/13

Hong.Van đã viết:
GIÚP SỬA CODE TÔ MÀU!
-------------------------------
Em có viết code tô màu cho cột E như sau:
Cột E này được phép nhập kiểu Number (ví dụ: 301) hoặc kiểu chuỗi, nhưng không được có ký tự là chữ lẫn lộn vào , ví dụ:
'0000301 -> OK
a301 -> không được
30ab1 ->không được
301dg -> không được
-----------
Code em như sau

Mã:

Sub TestMau_CotE() Dim i As Long Dim arrRes, arrSrc, rng As Range [A18:O2000].Font.ColorIndex = 1 Set rng = Range([A18], [A65536].End(3)).Resize(, 15) arrSrc = rng.Value For i = 1 To UBound(arrSrc, 1) If Val(arrSrc(i, 5)) = False Then rng(i, 5).Font.ColorIndex = 3 Next End Sub

Nhưng trong File của em, cell E24 & E30 không bị tô màu?
Em không biết fải sửa Val thành cái gì?
Em cảm ơn!

Để đơn giản hóa vấn đề, ta lấy thằng arrSrc(i, 5) nhân với 1, nếu báo lỗi (tức Err.Number >0) thì tô màu
Thế thôi

Mã:

Sub TestMau_CotE()
    Dim i As Long, tmp
    Dim arrRes, arrSrc, rng As Range
    [COLOR=#ff0000]On Error Resume Next[/COLOR]
    [A18:O2000].Font.ColorIndex = 1
    Set rng = Range([A18], [A65536].End(3)).Resize(, 15)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
      tmp = arrSrc(i, 5) * 1
      [COLOR=#ff0000]If Err.Number Then
        rng(i, 5).Font.ColorIndex = 3
        Err.Clear
      End If[/COLOR]
    Next
End Sub

Hoặc cách khác: Dùng IsNumeric

Mã:

Sub TestMau_CotE()
    Dim i As Long
    Dim arrRes, arrSrc, rng As Range
    [A18:O2000].Font.ColorIndex = 1
    Set rng = Range([A18], [A65536].End(3)).Resize(, 15)
    arrSrc = rng.Value
    For i = 1 To UBound(arrSrc, 1)
      [COLOR=#ff0000]If Not IsNumeric(arrSrc(i, 5)) Then[/COLOR] rng(i, 5).Font.ColorIndex = 3
    Next
End Sub

Hong.Van · 6/2/13

Cho em hỏi thêm, có hàm nào kiểm tra cell là số nguyên dương không ạ!
Em cảm ơn!

ndu96081631 · 6/2/13

Hong.Van đã viết:
Cho em hỏi thêm, có hàm nào kiểm tra cell là số nguyên dương không ạ!
Em cảm ơn!

Tôi cũng không biết nữa, nhưng nếu tôi làm thì sẽ vầy:

Mã:

If IsNumeric(Số) then ''<--- Kiểm tra xem có phải là số không
  If Số > 0 then ''<--- Kiểm tra xem số có dương không?
    If Int(Số) = Số  then ''<--- Kiểm tra xem số có nguyên không

gakon_Office · 6/2/13

quanghai1969 đã viết:
Chắc đại loại là thế này. Giả sử pass của bạn là 123456789

PHP:

Sub mo_file() Dim pass pass = Application.InputBox("Nhap Pass:") If pass <> 123456789 Then Exit Sub Workbooks.Open duongdantenfile, , , , pass End Sub

Dear, Anh Hải cùng các Thầy Cô!
Em không dùng code mở file mà dùng code này cơ ạ.

PHP:

ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

Liệu có cách nào mở pass với code này không ạ?
ví dụ pas mở các file con để links dữ liệu vẫn là :123456789

quykiemsau · 6/2/13

Hỏi về Biến ký tự thành dấu * trong Input?

Xin chào mọi người.
Em có đoạn code này:
Sub BackupFiles()

HTML:

Dim Pass
    Pass = Application.InputBox("Xin vui lòng nhâp Password:")
If Pass = ("123") Then
End If
End Sub

Xin hỏi có cách nào khi nhập 123 đấy nó hiển thị thành dấu * như password không?
Ví dụ như hình ảnh:
Theo code của Em thì nó thế này:

Xin hỏi phải viết code thế nào để nó thành thế này được ạ:

Mong các chuyên gia giúp đỡ. Xin cám ơn!

Quang_Hải · 6/2/13

QuỷKiếmSầu đã viết:
Xin chào mọi người.
Em có đoạn code này:
Sub BackupFiles()

HTML:

Dim Pass Pass = Application.InputBox("Xin vui lòng nhâp Password:") If Pass = ("123") Then End If End Sub

Xin hỏi có cách nào khi nhập 123 đấy nó hiển thị thành dấu * như password không?
Ví dụ như hình ảnh:
Theo code của Em thì nó thế này:View attachment 96940

Xin hỏi phải viết code thế nào để nó thành thế này được ạ:View attachment 96941
Mong các chuyên gia giúp đỡ. Xin cám ơn!

Theo mình biết thì không thể được đâu.

kyo · 6/2/13

Dùng inputbox thì có thể không được nhưng nếu tạo 1 userform có textbox trong đó thì có thể làm được thông qua thuộc tính passwordchar của textbox.

nmhung49 · 6/2/13

quanghai1969 đã viết:
Theo mình biết thì không thể được đâu.

Với trinh độ mình thì không được nhưng với người khác em nghĩ là không gì là không thể

Code trong Classmodule

PHP:

Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long)
    Dim UF                                              'Store the VBComponent
    Dim VUF As Object                                   'Store the userform object
    Dim Lb  As Object                                   'Label for the Prompt
    Dim Tb  As Object                                   'TextBox which holds the password
    Dim BOk  As Object
    Dim BCancel  As Object
    Dim VBAVisible As Boolean                           'Store VBE.Mainwindow visible state to restore it
    Dim i As Integer
    
    'Default Title is the same as InputBox
    If Len(Title) = 0 Then Title = Application.Name
    
    'Store the visible property of the VBE mainwindow and hide it to prevent screen flashing
    VBAVisible = Application.VBE.MainWindow.Visible
    Application.VBE.MainWindow.Visible = False
    
    'Add temporary Userform
    Set UF = ThisWorkbook.VBProject.VBComponents.Add(3)
    
    'Add the textbox.  If no PasswordChar was supplied, the text will appear normally
    Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1")
    With Tb
        .PasswordChar = PasswordChar
        .Left = 4.5
        .Top = 69.75
        .Width = 254.25
        .Height = 15.75
        .Value = Default
    End With
    
    'Add the prompt
    Set Lb = UF.Designer.Controls.Add("Forms.Label.1")
    With Lb
        .Caption = Prompt
        .WordWrap = True
        .Left = 6.75
        .Top = 6.75
        .Width = 198
        .Height = 54
    End With
    
    'Button OK, it is the default button
    Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk")
    With BOk
        .Caption = "OK"
        .Left = 209.25
        .Top = 4.5
        .Width = 49.5
        .Height = 18
        .Default = True
    End With
    
    'Button Cancel
    Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel")
    With BCancel
        .Caption = "Cancel"
        .Cancel = True
        .Left = 209.25
        .Top = 27
        .Width = 49.5
        .Height = 18
    End With
    
    'Add code to the Userform module
    With UF.CodeModule
        i = .CountOfLines
        'MyText is a variant which will hold the answer the user pressed
        .InsertLines i + 0, "Public MyText as Variant"
        
        'Pressed Cancel, so assign False to MyText
        .InsertLines i + 1, "Private Sub BCancel_Click()"
        .InsertLines i + 2, "   MyText = False: Me.Hide"
        .InsertLines i + 3, "End Sub"
        
        'Pressed Ok, so assign the value of TextBox1 to MyText
        .InsertLines i + 4, "Private Sub BOk_Click()"
        .InsertLines i + 5, "   MyText = TextBox1.Value: Me.Hide"
        .InsertLines i + 6, "End Sub"
    
        'Closing the form using "X", so assign False to MyText
        .InsertLines i + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
        .InsertLines i + 8, "   If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide"
        .InsertLines i + 9, "End Sub"
    End With
    'Properties for the userform
    With UF
        .Properties("Caption") = Title
        .Properties("Width") = 273
        .Properties("Height") = 108.75
        
        'Center on screen or show in a specific position
        If XPos > 0 Or YPos > 0 Then
            .Properties("StartUpPosition") = 0
            .Properties("Left") = XPos
            .Properties("Top") = YPos
        Else
            .Properties("StartUpPosition") = 1
        End If
    End With
    
    'Include the UF in the Userforms collection
    Set VUF = VBA.UserForms.Add(UF.Name)
    
    'Show the Userform
    VUF.Show
    'Pass the result to this function
    PassInputBox = VUF.MyText
    'Remove the VBcomponet
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF
    
    'Restore the VBE Mainwindow
    Application.VBE.MainWindow.Visible = VBAVisible
End Function

Code trong Module

PHP:

Sub Test()
    Dim ans As Variant            'ans is declared Variant to work similar to Application.InputBox
    Dim App As PwdInputBox        'Reference the class module
    Set App = New PwdInputBox     'Create a new instance
    
    ans = App.PassInputBox("Please enter the password", "*", "My Application") 'Show the Inputbox and store the result
    If ans = False Then
        MsgBox "Pressed Cancel"
    Else
        MsgBox "The password entered is: " & ans
    End If
End Sub

Bạn code thể tham khảo file sau
Website: MrExcel

Quang_Hải · 6/2/13

nmhung49 đã viết:
Với trinh độ mình thì không được nhưng với người khác em nghĩ là không gì là không thể
Bạn code thể tham khảo file sau
Website: MrExcel

Sao phức tạp thế. Vậy thôi vẽ cái userform rồi thêm cái textbox cho nhẹ cái đầu. Hic nhìn code mà phát khiếp rồi.

ndu96081631 · 6/2/13

nmhung49 đã viết:
Với trinh độ mình thì không được nhưng với người khác em nghĩ là không gì là không thể

Cách này quá thường, vì cuối cùng nó cũng tạo 1 UserForm tạm giả lập cái InputBox ấy thôi ---> Chẳng có gì đáng nói cả
Bài này:
http://www.giaiphapexcel.com/forum/showthread.php?40985-Chuyển-ký-tự-sang-dạng-*&p=271197#post271197
Mới đúng là chuyển ký tự password thành dấu * trên InputBox

quykiemsau · 6/2/13

kyo đã viết:
Dùng inputbox thì có thể không được nhưng nếu tạo 1 userform có textbox trong đó thì có thể làm được thông qua thuộc tính passwordchar của textbox.

Phiền GPE có thể cho em 1 ví dụ đính kèm đơn giản được không ạ?

Quang_Hải · 6/2/13

QuỷKiếmSầu đã viết:
Phiền GPE có thể cho em 1 ví dụ đính kèm đơn giản được không ạ?

Xem file bài 52 coi thế nào

quykiemsau · 6/2/13

nmhung49 đã viết:

Với trinh độ mình thì không được nhưng với người khác em nghĩ là không gì là không thể

Code trong Classmodule

PHP:

Function PassInputBox(Prompt As String, Optional PasswordChar As String, Optional Title As String, Optional Default As String, Optional XPos As Long, Optional YPos As Long)
    Dim UF                                              'Store the VBComponent
    Dim VUF As Object                                   'Store the userform object
    Dim Lb  As Object                                   'Label for the Prompt
    Dim Tb  As Object                                   'TextBox which holds the password
    Dim BOk  As Object
    Dim BCancel  As Object
    Dim VBAVisible As Boolean                           'Store VBE.Mainwindow visible state to restore it
    Dim i As Integer
    
    'Default Title is the same as InputBox
    If Len(Title) = 0 Then Title = Application.Name
    
    'Store the visible property of the VBE mainwindow and hide it to prevent screen flashing
    VBAVisible = Application.VBE.MainWindow.Visible
    Application.VBE.MainWindow.Visible = False
    
    'Add temporary Userform
    Set UF = ThisWorkbook.VBProject.VBComponents.Add(3)
    
    'Add the textbox.  If no PasswordChar was supplied, the text will appear normally
    Set Tb = UF.Designer.Controls.Add("Forms.Textbox.1", "TextBox1")
    With Tb
        .PasswordChar = PasswordChar
        .Left = 4.5
        .Top = 69.75
        .Width = 254.25
        .Height = 15.75
        .Value = Default
    End With
    
    'Add the prompt
    Set Lb = UF.Designer.Controls.Add("Forms.Label.1")
    With Lb
        .Caption = Prompt
        .WordWrap = True
        .Left = 6.75
        .Top = 6.75
        .Width = 198
        .Height = 54
    End With
    
    'Button OK, it is the default button
    Set BOk = UF.Designer.Controls.Add("Forms.CommandButton.1", "BOk")
    With BOk
        .Caption = "OK"
        .Left = 209.25
        .Top = 4.5
        .Width = 49.5
        .Height = 18
        .Default = True
    End With
    
    'Button Cancel
    Set BCancel = UF.Designer.Controls.Add("Forms.CommandButton.1", "BCancel")
    With BCancel
        .Caption = "Cancel"
        .Cancel = True
        .Left = 209.25
        .Top = 27
        .Width = 49.5
        .Height = 18
    End With
    
    'Add code to the Userform module
    With UF.CodeModule
        i = .CountOfLines
        'MyText is a variant which will hold the answer the user pressed
        .InsertLines i + 0, "Public MyText as Variant"
        
        'Pressed Cancel, so assign False to MyText
        .InsertLines i + 1, "Private Sub BCancel_Click()"
        .InsertLines i + 2, "   MyText = False: Me.Hide"
        .InsertLines i + 3, "End Sub"
        
        'Pressed Ok, so assign the value of TextBox1 to MyText
        .InsertLines i + 4, "Private Sub BOk_Click()"
        .InsertLines i + 5, "   MyText = TextBox1.Value: Me.Hide"
        .InsertLines i + 6, "End Sub"
    
        'Closing the form using "X", so assign False to MyText
        .InsertLines i + 7, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
        .InsertLines i + 8, "   If CloseMode = 0 Then Cancel = True: MyText = False: Me.Hide"
        .InsertLines i + 9, "End Sub"
    End With
    'Properties for the userform
    With UF
        .Properties("Caption") = Title
        .Properties("Width") = 273
        .Properties("Height") = 108.75
        
        'Center on screen or show in a specific position
        If XPos > 0 Or YPos > 0 Then
            .Properties("StartUpPosition") = 0
            .Properties("Left") = XPos
            .Properties("Top") = YPos
        Else
            .Properties("StartUpPosition") = 1
        End If
    End With
    
    'Include the UF in the Userforms collection
    Set VUF = VBA.UserForms.Add(UF.Name)
    
    'Show the Userform
    VUF.Show
    'Pass the result to this function
    PassInputBox = VUF.MyText
    'Remove the VBcomponet
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=UF
    
    'Restore the VBE Mainwindow
    Application.VBE.MainWindow.Visible = VBAVisible
End Function

Code trong Module

PHP:

Sub Test()
    Dim ans As Variant            'ans is declared Variant to work similar to Application.InputBox
    Dim App As PwdInputBox        'Reference the class module
    Set App = New PwdInputBox     'Create a new instance
    
    ans = App.PassInputBox("Please enter the password", "*", "My Application") 'Show the Inputbox and store the result
    If ans = False Then
        MsgBox "Pressed Cancel"
    Else
        MsgBox "The password entered is: " & ans
    End If
End Sub

Bạn code thể tham khảo file sau
Website: MrExcel

Em vừa chạy phát báo lỗi luôn ??

Phải xử lý thế nào ạ?

ndu96081631 · 6/2/13

QuỷKiếmSầu đã viết:
Phiền GPE có thể cho em 1 ví dụ đính kèm đơn giản được không ạ?

Thì bạn cứ vẽ 1 UserForm với 1 TextBox... Thuộc tính PasswordChar của TextBox, gõ dấu * vào (mấu chốt nằm ở đây thôi)
Còn code thì viết thế nào là tùy bạn thôi

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

QuỷKiếmSầu đã viết:
Em vừa chạy phát báo lỗi luôn ??

Phải xử lý thế nào ạ?

Quan trọng câu thông báo lỗi là gì?
Với code dạng chỉnh sửa gì đó trong cửa sổ VBA, để chạy được nó bắt buộc bạn phải check mục "Trust access to VBA project...." (nằm trong Excel Options\Trust Center\Macro Settings)

quykiemsau · 6/2/13

Em biết Chỗ Thầy chỉ rồi.
Nhưng code fai viết theo cấu trúc kểu gì ạ,
ví dụ pass là:123
Nếu pass đúng thì sẽ thực hiện yêu cầu.
Nếu sai pass exit sub.

Thầy cho em 1 ví dụ (đoạn code) gán điều kiện code vào bài này với ạ.

quykiemsau · 6/2/13

ndu96081631 đã viết:
Quan trọng câu thông báo lỗi là gì?
Với code dạng chỉnh sửa gì đó trong cửa sổ VBA, để chạy được nó bắt buộc bạn phải check mục "Trust access to VBA project...." (nằm trong Excel Options\Trust Center\Macro Settings)

Em làm như Thầy chỉ rồi nhưng nó vẫn bị lỗi mà Thầy.

Quang_Hải · 6/2/13

QuỷKiếmSầu đã viết:
Em biết Chỗ Thầy chỉ rồi.
Nhưng code fai viết theo cấu trúc kểu gì ạ,
ví dụ pass là:123
Nếu pass đúng thì sẽ thực hiện yêu cầu.
Nếu sai pass exit sub.

Thầy cho em 1 ví dụ (đoạn code) gán điều kiện code vào bài này với ạ.

Tiếp tục thử xem sao

quykiemsau · 6/2/13

OK! Ajingon > Xin Cám ơn Anh 2!

Hong.Van · 7/2/13

Em có code Protect & unprotect toàn bộ các Sheet trong 1 File

Mã:

Sub Khoa_Mo()
    Dim sh As Worksheet, shapes
    Application.ScreenUpdating = False
    On Error Resume Next
    With shapes("Button 1").TextFrame.Characters
        For Each sh In ThisWorkbook.Worksheets
            sh.Protect "hv" = .Text = "Khoa"
        Next
        .Text = IIf(.Text = "Khoa", "Mo", "Khoa")
    End With
    Application.ScreenUpdating = True
End Sub

Em có nút Button 1, để khi nhấn thì nó hiện chữ " Khoa", "Mo"
Không biết code còn sai chỗ nào mà nó kh chạy & nút Button 1 không hiện chữ " Khoa", "Mo"
Em nhờ Thầy cô & anh chị giúp em, em cảm ơn!

ndu96081631 · 7/2/13

Hong.Van đã viết:
Em có code Protect & unprotect toàn bộ các Sheet trong 1 File

Mã:

Sub Khoa_Mo() Dim sh As Worksheet, shapes Application.ScreenUpdating = False On Error Resume Next With shapes("Button 1").TextFrame.Characters For Each sh In ThisWorkbook.Worksheets sh.Protect "hv" = .Text = "Khoa" Next .Text = IIf(.Text = "Khoa", "Mo", "Khoa") End With Application.ScreenUpdating = True End Sub

Em có nút Button 1, để khi nhấn thì nó hiện chữ " Khoa", "Mo"
Không biết code còn sai chỗ nào mà nó kh chạy & nút Button 1 không hiện chữ " Khoa", "Mo"
Em nhờ Thầy cô & anh chị giúp em, em cảm ơn!

Sai nhiều chổ quá! Lý ra bạn nên bỏ dòng On Error Resume Next để biết lỗi ở đâu chứ
-------------
Tôi viết lại theo kiểu khác:

Mã:

Sub WksProtected(ByVal isLock As Boolean, ByVal sPW As String)
  Dim wks As Worksheet
  For Each wks In ThisWorkbook.Worksheets
    If isLock Then
      wks.Protect sPW, [COLOR=#ff0000]False[/COLOR]
    Else
      wks.Unprotect sPW
    End If
  Next
End Sub

Mã:

Sub Main()
  With ActiveSheet.shapes("Button 1").TextFrame.Characters
    WksProtected (.Text = "Khoa"), "hv"
    .Text = IIf(.Text = "Khoa", "Mo Khoa", "Khoa")
  End With
End Sub

Assign Macro Button 1 cho Sub Main rồi nhấn nút thí nghiệm
---------------
Lưu ý chữ False màu đỏ nhé ---> Có nó mới có thể thay đổi chuổi trên Button 1 được
---------------
Hoặc code y chang của bạn:

Mã:

Sub Khoa_Mo()
  Dim sh As Worksheet, shp As Shape
  Application.ScreenUpdating = False
  Set shp = ActiveSheet.shapes("Button 1")
 ' On Error Resume Next
  With shp.TextFrame.Characters
    For Each sh In ThisWorkbook.Worksheets
      If .Text = "Khoa" Then
        sh.Protect "hv", [COLOR=#ff0000]False[/COLOR]
      Else
        sh.Unprotect "hv"
      End If
    Next
    .Text = IIf(.Text = "Khoa", "Mo", "Khoa")
  End With
  Application.ScreenUpdating = True
End Sub

Nhưng theo tôi thì cách 1 hay hơn, khả năng tùy biến cao hơn

Hong.Van · 7/2/13

GIÚP EM SỬA LỖI CODE
--------------------
Trong File em có 2 sheet là "ToKhai" Và "MuaVao"
Tại G7 của Sheet "ToKhai" em có đặt List Validation
Trong Sheet "ToKhai" em có code như sau

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Address = [g7].Address Then
        If Target.Value <> Sheets("MuaVao").Range("G7").Value Then MsgBox " So Chua chinh xac"


    End If
    Application.ScreenUpdating = True
End Sub

Mục đích em khi chọn cell G7 của sheet "ToKhai" mà có giá trị khác với giá trị cell G7 của sheet "MuaVao" thì thông báo "So Chua chinh xac"
Nhưng code em chưa chính xác! nên nó kg thèm thông báo!
Nhờ Thầy cô & anh chị giúp em.Em cảm ơn!

hoamattroicoi · 7/2/13

Hong.Van đã viết:
GIÚP EM SỬA LỖI CODE
--------------------
Trong File em có 2 sheet là "ToKhai" Và "MuaVao"
Tại G7 của Sheet "ToKhai" em có đặt List Validation
Trong Sheet "ToKhai" em có code như sau

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Target.Address = [g7].Address Then If Target.Value <> Sheets("MuaVao").Range("G7").Value Then MsgBox " So Chua chinh xac" End If Application.ScreenUpdating = True End Sub

Mục đích em khi chọn cell G7 của sheet "ToKhai" mà có giá trị khác với giá trị cell G7 của sheet "MuaVao" thì thông báo "So Chua chinh xac"
Nhưng code em chưa chính xác! nên nó kg thèm thông báo!
Nhờ Thầy cô & anh chị giúp em.Em cảm ơn!

Mình không rành lắm trong chuyện nhìn code đoán ý đồ nhưng mình thấy câu lệnh này kỳ kỳ bạn ạ :

If Target.Address = [g7].Address

Sao không viết là :

If Target.Address = "$G$7"

Nếu có thể cho mình ngó cái file được không???

Quang_Hải · 7/2/13

Hong.Van đã viết:
GIÚP EM SỬA LỖI CODE
--------------------
Trong File em có 2 sheet là "ToKhai" Và "MuaVao"
Tại G7 của Sheet "ToKhai" em có đặt List Validation
Trong Sheet "ToKhai" em có code như sau

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Target.Address = [g7].Address Then If Target.Value <> Sheets("MuaVao").Range("G7").Value Then MsgBox " So Chua chinh xac" End If Application.ScreenUpdating = True End Sub

Mục đích em khi chọn cell G7 của sheet "ToKhai" mà có giá trị khác với giá trị cell G7 của sheet "MuaVao" thì thông báo "So Chua chinh xac"
Nhưng code em chưa chính xác! nên nó kg thèm thông báo!
Nhờ Thầy cô & anh chị giúp em.Em cảm ơn!

Mình thấy code không sai. Có thể do nguyên nhân khác. Gởi file lên xem thử thì biết liền

hoamattroicoi đã viết:
If Target.Address = [g7].Address
Sao không viết là :
If Target.Address = "$G$7"
Nếu có thể cho mình ngó cái file được không???

Câu lệnh này tương đương nhau bé Còi ơi

Hong.Van · 7/2/13

hoamattroicoi đã viết:
Mình không rành lắm trong chuyện nhìn code đoán ý đồ nhưng mình thấy câu lệnh này kỳ kỳ bạn ạ :

If Target.Address = [g7].Address

Sao không viết là :

If Target.Address = "$G$7"

Nếu có thể cho mình ngó cái file được không???

Cảm ơn HMTC, làm từ nãy đến giờ nó không thông báo, mở file định gởi lên mạng thì nó hiện thông báo!!!
Chắc nó sợ HMTC!!!

hoamattroicoi · 7/2/13

quanghai1969 đã viết:
Mình thấy code không sai. Có thể do nguyên nhân khác. Gởi file lên xem thử thì biết liền

Câu lệnh này tương đương nhau bé Còi ơi

I see nhưng em cứ thích sửa thành thế đó, làm gì được nhau nào? he he...Nói vậy thôi chứ đó là thói quen của em mà, anh có công nhận sửa thế trông code nó đẹp hơn và chính tắc hơn không?

Cảm ơn HMTC, làm từ nãy đến giờ nó không thông báo, mở file định gởi lên mạng thì nó hiện thông báo!!!
Chắc nó sợ HMTC!!!

+ + Ẹ..........

ndu96081631 · 7/2/13

Hong.Van đã viết:
Cảm ơn HMTC, làm từ nãy đến giờ nó không thông báo, mở file định gởi lên mạng thì nó hiện thông báo!!!
Chắc nó sợ HMTC!!!

Sự kiện Change nó hơi nhạy cảm! Đôi lúc ta test code bị lỗi, sửa lại code đúng rồi nhưng cái sự kiện Change ấy vẫn cứ trở trơ ra
Kinh nghiệm của tôi: Đóng và lưu file, xong mở lại rồi test tiếp

kyo · 7/2/13

ndu96081631 đã viết:
Sự kiện Change nó hơi nhạy cảm! Đôi lúc ta test code bị lỗi, sửa lại code đúng rồi nhưng cái sự kiện Change ấy vẫn cứ trở trơ ra
Kinh nghiệm của tôi: Đóng và lưu file, xong mở lại rồi test tiếp

Theo kyo nghĩ là tại dòng Application.ScreenUpdating = False nên nó mới bị trơ trơ đây. Do nó chưa được True (tức là chưa làm xong hết) thì hoặc là code lỗi và người dùng stop lại hoặc nó đang chạy giữa chừng đi break nó nên nó đơ luôn.
Nếu thấy đơ cứ lôi Immediate Window ra cho nó True là xong.

Hong.Van · 7/2/13

Em có sưu tầm 1 số code của Thầy Ndu như:
Khóa_Mở (Protect Sheet ), Show all Sheet

Mã:

Sub Khoa_Mo()
    Dim sh As Worksheet, shp As Shape
    Application.ScreenUpdating = False
    Set shp = ActiveSheet.Shapes("Button 2")
    
    With shp.TextFrame.Characters
        For Each sh In ThisWorkbook.Worksheets
            If .Text = "Mo" Then
                sh.Unprotect "HV"
                
            Else
                sh.Protect "HV", False
                
            End If
        Next
        .Text = IIf(.Text = "Mo", "Khoa", "Mo")
    End With
    Application.ScreenUpdating = True
End Sub

Mã:

Sub ShowAllShs_T()    Dim sh As Worksheet
    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheet4.Shapes("Button 1").TextFrame.Characters
        For Each sh In ThisWorkbook.Worksheets
            If sh.Name <> "Main" Then
                sh.Visible = .Text = "SHOW ALL"
            End If
        Next
        .Text = IIf(.Text = "SHOW ALL", "HIDE ALL", "SHOW ALL")
    End With
    Application.ScreenUpdating = True
End Sub

Và em dùng Sub Aut

pen, để khi mở File thì nó ẩn các Sheet (Trừ Main) và khóa toàn bộ Sheet

Mã:

Sub Auto_Open()
    Dim wks As Worksheet, shp1 As Shape, shp2 As Shape
    Set wks = Worksheets("Main")
    Set shp1 = wks.Shapes("Button 1")
    If shp1.TextFrame.Characters.Text = "HIDE ALL" Then ShowAllShs_T
    '******************
    Set shp2 = wks.Shapes("Button 2")
    If shp2.TextFrame.Characters.Text = "Khoa" Then Khoa_Mo
End Sub

-------------
Nhưng khi mở File và Disable thì em vẫn có thể mở các sheet bằng cách Format/sheet/Unhide
Vậy cho em hỏi có cách nào khi mở File nếu không Enable thì không thể nào làm hiện các Sheet bằng Format/sheet/Unhide? Giống như các Sheet bị ẩn bởi Very Hidden !
Em cảm ơn!

ndu96081631 · 7/2/13

kyo đã viết:
Theo kyo nghĩ là tại dòng Application.ScreenUpdating = False nên nó mới bị trơ trơ đây. Do nó chưa được True (tức là chưa làm xong hết) thì hoặc là code lỗi và người dùng stop lại hoặc nó đang chạy giữa chừng đi break nó nên nó đơ luôn.
Nếu thấy đơ cứ lôi Immediate Window ra cho nó True là xong.

Không đâu, vụ này tôi biết chứ. Và thêm nữa, chẳng mấy khi tôi dùng ScreenUpdating, nhất là với sự kiện Change
Nói chung là hiếm khi nào mà tôi viết code 1 phát được ngay. Thế nào cũng bị một vài lỗi gì đó... và khi code bị lỗi này lại là code của sự kiện WorksheetChange thì y như rằng nó hay bị đơ...
Cũng chính thế mà tôi cũng rất ngại dùng sự kiện này (nhất là viết cho người khác dùng)

ndu96081631 · 7/2/13

Hong.Van đã viết:
Em có sưu tầm 1 số code của Thầy Ndu như:

Mã:

Sub ShowAllShs_T() Dim sh As Worksheet Application.ScreenUpdating = False On Error Resume Next With Sheet4.Shapes("Button 1").TextFrame.Characters For Each sh In ThisWorkbook.Worksheets If sh.Name <> "Main" Then [COLOR=#ff0000][B]sh.Visible = .Text = "SHOW ALL"[/B][/COLOR] End If Next .Text = IIf(.Text = "SHOW ALL", "HIDE ALL", "SHOW ALL") End With Application.ScreenUpdating = True End Sub

Nhưng khi mở File và Disable thì em vẫn có thể mở các sheet bằng cách Format/sheet/Unhide
Vậy cho em hỏi có cách nào khi mở File nếu không Enable thì không thể nào làm hiện các Sheet bằng Format/sheet/Unhide? Giống như các Sheet bị ẩn bởi Very Hidden !
Em cảm ơn!

Sửa đoạn màu đỏ thành vầy sh.Visible = (.Text = "SHOW ALL") + 2

hoanglocphat · 18/2/13

Trong code làm sao quy định nó lớn hơn 0,001 (Không phẩy không không một) được
Ex:

Mã:

 If Array(I, 3) > 0,001 Or Array(I, 4) > 0,001  Then

Mình làm như trên thì báo lỗi
Vậy cho hỏi code trên sửa như thế nào?
Cảm ơn các bạn!

dhn46 · 18/2/13

hoanglocphat đã viết:
Trong code làm sao quy định nó lớn hơn 0,001 (Không phẩy không không một) được
Ex:

Mã:

If Array(I, 3) > 0,001 Or Array(I, 4) > 0,001 Then

Mình làm như trên thì báo lỗi
Vậy cho hỏi code trên sửa như thế nào?
Cảm ơn các bạn!

Bạn đưa File chứa Code của bạn lên xem bị lỗi là do nào. Tôi tạm đoán do dấu cách thập phân của bạn không đúng với quy định trong máy (có thể thay dấu , bằng .).

ndu96081631 · 18/2/13

dhn46 đã viết:
Bạn đưa File chứa Code của bạn lên xem bị lỗi là do nào. Tôi tạm đoán do dấu cách thập phân của bạn không đúng với quy định trong máy (có thể thay dấu , bằng .).

Nếu tôi nhớ không lầm thì cho dù ta Set định dạng number trong Control Panel thế nào đi nữa thì trong VBA vẫn theo chuẩn Mỹ (tức dấu chấm là dấu thập phân và dấu phẩy là dấu phân cách ngàn)
Thí nghiệm xem!

dhn46 · 18/2/13

ndu96081631 đã viết:
Nếu tôi nhớ không lầm thì cho dù ta Set định dạng number trong Control Panel thế nào đi nữa thì trong VBA vẫn theo chuẩn Mỹ (tức dấu chấm là dấu thập phân và dấu phẩy là dấu phân cách ngàn)
Thí nghiệm xem!

Dạ tại bạn ấy nói là "Lỗi" nhưng không nói là lỗi do công đoạn nào. VBA luôn hiểu dấu phân cách là dấu chấm nên nếu lỗi tại cửa sổ lập trình thì do bạn ấy dùng dấu phẩy (lỗi ngay tại quá trình viết Code chứ chưa có Run Code). Em đoán là như vậy thầy ah.

hoanglocphat · 19/2/13

dhn46 đã viết:
Dạ tại bạn ấy nói là "Lỗi" nhưng không nói là lỗi do công đoạn nào. VBA luôn hiểu dấu phân cách là dấu chấm nên nếu lỗi tại cửa sổ lập trình thì do bạn ấy dùng dấu phẩy (lỗi ngay tại quá trình viết Code chứ chưa có Run Code). Em đoán là như vậy thầy ah.

1/ Định dạng number trong Control Panel của tôi là: dấu phẩy dùng ngăn cách số thập phân. Dấu chấm phẩy dùng để ngăn cách trong công thức
2/ Khi nhập 0,001 trong cửa sổ VBA thì bị báo lỗi dòng màu đỏ là "Expected Then or GoTo" (chứ không phải Run code mới báo lỗi)

ndu96081631 · 19/2/13

hoanglocphat đã viết:
1/ Định dạng number trong Control Panel của tôi là: dấu phẩy dùng ngăn cách số thập phân. Dấu chấm phẩy dùng để ngăn cách trong công thức
2/ Khi nhập 0,001 trong cửa sổ VBA thì bị báo lỗi dòng màu đỏ là "Expected Then or GoTo" (chứ không phải Run code mới báo lỗi)

Thì đúng vậy rồi. "Nó" tưởng dấu phẩy của bạn là dấu phân cách các thành phần trong VBA rồi phân tích.. cuối cùng là đếch hiểu bạn viết gì nên "nó" cự thôi
Ẹc... Ẹc...
Tóm lại: Bạn set gì trong Control Panel thì cứ thây kệ đi, trong VBA cứ theo chuẩn Mỹ là được

KUMI · 23/2/13

Hỏi về cách nhập dữ liệu theo điều kiện bắt buộc.

Xin chào mọi người.
Em đang sử dụng cái combox của Thầy Quang Hải
Nhưng em thấy vẫn chưa yên tâm về một chỗ đó là Em muốn hỏi làm sao có thể bắt buộc nhập dữ liệu theo những điều kiện trong list ở các dòng màu xanh.(không cho nhập lung tung).
Kiểu là dạng như datavalition trong vùng màu đỏ đấy ạ.

Mọi người xem file đính kèm và giúp em với ạ, Xin cám ơn!

gakon_Office · 23/2/13

KUMI đã viết:
Xin chào mọi người.
Em đang sử dụng cái combox của Thầy Quang Hải
Nhưng em thấy vẫn chưa yên tâm về một chỗ đó là Em muốn hỏi làm sao có thể bắt buộc nhập dữ liệu theo những điều kiện trong list ở các dòng màu xanh.(không cho nhập lung tung).
Kiểu là dạng như datavalition trong vùng màu đỏ đấy ạ.

Mọi người xem file đính kèm và giúp em với ạ, Xin cám ơn!

Chắc không có cách nào đâu bạn ah.
Mình đã thử đưa cả valiton vào cùng cái combox nhưng vẫn không được,
Có lẽ phải nhờ các chuyên gia GPE chỉnh lại code thôi.

Quang_Hải · 23/2/13

KUMI đã viết:
Xin chào mọi người.
Em đang sử dụng cái combox của Thầy Quang Hải
Nhưng em thấy vẫn chưa yên tâm về một chỗ đó là Em muốn hỏi làm sao có thể bắt buộc nhập dữ liệu theo những điều kiện trong list ở các dòng màu xanh.(không cho nhập lung tung).
Kiểu là dạng như datavalition trong vùng màu đỏ đấy ạ.

Mọi người xem file đính kèm và giúp em với ạ, Xin cám ơn!

Mình gợi ý thế này nha
Thêm cái khóa sheet và cái mở sheet nữa chắc là được. Thử đi, nếu khi nào bí quá thì mình giúp cho. Phải tập bơi chứ.

nhapmon · 23/2/13

KUMI đã viết:
Xin chào mọi người.
Em đang sử dụng cái combox của Thầy Quang Hải
Nhưng em thấy vẫn chưa yên tâm về một chỗ đó là Em muốn hỏi làm sao có thể bắt buộc nhập dữ liệu theo những điều kiện trong list ở các dòng màu xanh.(không cho nhập lung tung).
Kiểu là dạng như datavalition trong vùng màu đỏ đấy ạ.

Mọi người xem file đính kèm và giúp em với ạ, Xin cám ơn!

Ý bạn là không cho nhập từ bàn phím vào phải ko?
bạn vào properties của combobox, chọn style
chọn 2-fmStyleDropDownList

mhung12005 · 23/2/13

KUMI đã viết:
Xin chào mọi người.
Em đang sử dụng cái combox của Thầy Quang Hải
Nhưng em thấy vẫn chưa yên tâm về một chỗ đó là Em muốn hỏi làm sao có thể bắt buộc nhập dữ liệu theo những điều kiện trong list ở các dòng màu xanh.(không cho nhập lung tung).
Kiểu là dạng như datavalition trong vùng màu đỏ đấy ạ.

Mọi người xem file đính kèm và giúp em với ạ, Xin cám ơn!

Bạn thêm dòng lệnh này vào sub hien:

Mã:

.Style = fmStyleDropDownList

KUMI · 23/2/13

Xin cám ơn mọi người đã tìm cách giúp đỡ!
Có vấn đề gì Em không làm được lại nhờ các Anh Chị và các Thầy nhé! Hihi

nhapmon · 6/3/13

mình lang thang trên diễn đan, copy được một đạon code lâu rồi, bi giờ định đen vào áp dụng, nhưng đọc tới đọc lui hoai mà ko biết dòng lệnh nào giúp nó loại giá trị trùng khi nạp vào combobox, nên nhờ ACE chỉ dùm

Sub addvalue()

Dim c As Range, Coll As New Collection
On Error Resume Next
For Each c In Range([D5], [D5000].End(xlUp))
Coll.Add c.Value, c.Value
Next c
On Error GoTo 0
For Each Item In Coll
Sheet1.ComboBox1.AddItem Item
Next Item

End Sub

Tks ACE nhiu nhìu

Quang_Hải · 6/3/13

nhapmon đã viết:
mình lang thang trên diễn đan, copy được một đạon code lâu rồi, bi giờ định đen vào áp dụng, nhưng đọc tới đọc lui hoai mà ko biết dòng lệnh nào giúp nó loại giá trị trùng khi nạp vào combobox, nên nhờ ACE chỉ dùm

Sub addvalue()

Dim c As Range, Coll As New Collection
On Error Resume Next
For Each c In Range([D5], [D5000].End(xlUp))
Coll.Add c.Value, c.Value
Next c
On Error GoTo 0
For Each Item In Coll
Sheet1.ComboBox1.AddItem Item
Next Item

End Sub

Tks ACE nhiu nhìu

Đối với Collection thì không có loại bỏ dữ liệu trùng. Khi gặp em nào có trong Coll rồi thì sẽ gây ra 1 lỗi. Câu lệnh On error Resume next giúp xử lý cái lỗi này, vây thôi.

PS: Coll không được tiện dụng cho lắm, tốt nhất xài Dictionary. Khi nạp dữ liệu vào Dic thì nạp vào Combobox luôn cho nhanh.

VetMini · 6/3/13

nhapmon đã viết:
mình lang thang trên diễn đan, copy được một đạon code lâu rồi, bi giờ định đen vào áp dụng, nhưng đọc tới đọc lui hoai mà ko biết dòng lệnh nào giúp nó loại giá trị trùng khi nạp vào combobox, nên nhờ ACE chỉ dùm

Sub addvalue()

Dim c As Range, Coll As New Collection
On Error Resume Next
For Each c In Range([D5], [D5000].End(xlUp))
Coll.Add c.Value, c.Value
Next c
On Error GoTo 0
For Each Item In Coll
Sheet1.ComboBox1.AddItem Item
Next Item

End Sub

Tks ACE nhiu nhìu

Thuật toán chính nằm ở chỗ tính chất của Collection là không cho ghi khoá đúp, nếu gặp khoá đã ghi rồi thì error - ghi không được. Code ở đây bắt lỗi error trong lúc ghi, rồi tiếp tục với dòng kế tiếp. Như vậy tất cả những trị đúp đều bị loại ra.

Kỹ thuật bắt lỗi này rất thông dụng cho ngôn ngữ thuộc dòng họ BASIC

hungpecc1 · 6/3/13

nhapmon đã viết:
mình lang thang trên diễn đan, copy được một đạon code lâu rồi, bi giờ định đen vào áp dụng, nhưng đọc tới đọc lui hoai mà ko biết dòng lệnh nào giúp nó loại giá trị trùng khi nạp vào combobox, nên nhờ ACE chỉ dùm

Sub addvalue()
Tks ACE nhiu nhìu

Cái này là dùng bẫy lỗi on Error .... " để loại bỏ giá trị trùng " <---- khi gặp giá trị trùng nó sẽ báo lỗi ----> gặp câu lệnh On Error Resume Next --> sub sẽ bỏ qua gía trị này và duyệt tiếp giá trị sau **~**

nhapmon · 6/3/13

quanghai1969 đã viết:
Đối với Collection thì không có loại bỏ dữ liệu trùng. Khi gặp em nào có trong Coll rồi thì sẽ gây ra 1 lỗi. Câu lệnh On error Resume next giúp xử lý cái lỗi này, vây thôi.

PS: Coll không được tiện dụng cho lắm, tốt nhất xài Dictionary. Khi nạp dữ liệu vào Dic thì nạp vào Combobox luôn cho nhanh.

cám ơn các anh nhìu nhìu.
cái Dic. nó không bít mình, nên mình ko dám sử dụng
nhờ anh viết dùm cách nạp vào combobox dữ liệu không trùng và sort theo A,B,C được không anh.
hiện nay tui phai advance filter ra một cột khác rồi mới nạp vào

ndu96081631 · 6/3/13

nhapmon đã viết:
cám ơn các anh nhìu nhìu.
cái Dic. nó không bít mình, nên mình ko dám sử dụng
nhờ anh viết dùm cách nạp vào combobox dữ liệu không trùng và sort theo A,B,C được không anh.
hiện nay tui phai advance filter ra một cột khác rồi mới nạp vào

Collection viết sao thì Dictionary viết gần như y chang vậy... Chỉ là Dictionary có thêm 1 số thuộc tính và phương thức khác hổ trợ mạnh hơn (chẳng hạn là phương thức Exists để xét sự tồn tại của 1 Key trong khi Collection không có)
----------------
Còn nói về Advanced Filter thì bạn đừng chê nó nha ---> Nó cho tốc độ tuyệt nhanh ---> Nếu đang dùng thì cứ vậy mà dùng đi

hungpecc1 · 6/3/13

nhapmon đã viết:
cám ơn các anh nhìu nhìu.
cái Dic. nó không bít mình, nên mình ko dám sử dụng
nhờ anh viết dùm cách nạp vào combobox dữ liệu không trùng và sort theo A,B,C được không anh.
hiện nay tui phai advance filter ra một cột khác rồi mới nạp vào

ndu96081631 đã viết:
----------------
Còn nói về Advanced Filter thì bạn đừng chê nó nha ---> Nó cho tốc độ tuyệt nhanh ---> Nếu đang dùng thì cứ vậy mà dùng đi

Thì bạn nói cách làm tay cho excel hiểu dưới dạng code -+*/

---> thử code dưới đấy xem :
[GPECODE=vb]
Sub addvalue()
Dim mycell As Range
Application.ScreenUpdating = 0
Range("D

").AdvancedFilter 2, , [IV1], 1
Range("IV1", [IV65536].End(3)).Sort [IV1]
For Each mycell In Range("IV1", [IV65536].End(3))
Sheet1.ComboBox1.AddItem mycell.Value
Next
[IV:IV].ClearContents
Application.ScreenUpdating = 1
End Sub
[/GPECODE]

Quang_Hải · 6/3/13

nhapmon đã viết:
cám ơn các anh nhìu nhìu.
cái Dic. nó không bít mình, nên mình ko dám sử dụng
nhờ anh viết dùm cách nạp vào combobox dữ liệu không trùng và sort theo A,B,C được không anh.
hiện nay tui phai advance filter ra một cột khác rồi mới nạp vào

Vẫn dùng Advanced xem thế nào

PHP:

Sub nap_list()
[E5:E10000].ClearContents
[D5:D10000].AdvancedFilter 2, , [E5], 1
Range([E5], [E65536].End(3)).Sort [E4]
Range([E5], [E65536].End(3)).Name = "list"
ActiveSheet.ComboBox1.ListFillRange = "list"
End Sub

ndu96081631 · 6/3/13

hungpecc1 đã viết:
Thì bạn nói cách làm tay cho excel hiểu dưới dạng code ---> thử code dưới đấy xem :
[GPECODE=vb]
Sub addvalue()
Dim mycell As Range
Application.ScreenUpdating = 0
Range("D").AdvancedFilter 2, , [IV1], 1
Range("IV1", [IV65536].End(3)).Sort [IV1]
For Each mycell In Range("IV1", [IV65536].End(3))
Sheet1.ComboBox1.AddItem mycell.Value
Next
[IV:IV].ClearContents
Application.ScreenUpdating = 1
End Sub
[/GPECODE]

Nạp vào ComboBox hoặc ListBox thì không cần phải vòng lập đâu
Ví dụ:

Mã:

Sub addvalue()
  Dim arr
  With Sheet1
    .Range("D5:D50000").AdvancedFilter 2, , .[IV1], 1
    With .Range("IV1", .[IV65536].End(3))
      .Sort .Cells(1, 1), Header:=xlYes
      arr = Intersect(.Cells, .Offset(1))
    End With
   .ComboBox1.List() = arr
   .[IV:IV].ClearContents
  End With
End Sub

Dùng Advanced Filter thì đường nhiên dữ liệu phải có tiêu đề. Nhưng khi nạp vào ComboBox, thông thường ta sẽ loại bỏ tiêu đề (chỉ lấy dữ liệu bên dưới)

nhapmon · 8/3/13

Chào ACE, chúc một ngày làm việc vui vẻ.
ACE cho tui hỏi: tui có một file excel có chứa một số đoạn macro, khi gởi file này cho người khác qua email, tui không muốn kèm các đoạn code này theo (vì người ta chỉ cần đọc kết quả).
cá cách nào không, nhờ ACE chỉ dùm

tks so much

ndu96081631 · 8/3/13

nhapmon đã viết:
Chào ACE, chúc một ngày làm việc vui vẻ.
ACE cho tui hỏi: tui có một file excel có chứa một số đoạn macro, khi gởi file này cho người khác qua email, tui không muốn kèm các đoạn code này theo (vì người ta chỉ cần đọc kết quả).
cá cách nào không, nhờ ACE chỉ dùm

tks so much

Thì bạn copy paste value, xóa hết macro, công thức đi là được rồi
Đơn giản hơn nữa: Chuyển mọi thứ thành PDF (ví như bạn nói người ta chỉ cần đọc kết quả)

nhapmon · 8/3/13

cám ơn anh nhiều, nhưng nhiều sheet, copy past value cũng hơi oai. để tôi install cái convert qua PDF thử.

VetMini · 8/3/13

Tự xoá bài vì đăng không đúng chỗ - xin lỗi mọi người.

ndu96081631 · 8/3/13

nhapmon đã viết:
cám ơn anh nhiều, nhưng nhiều sheet, copy past value cũng hơi oai. để tôi install cái convert qua PDF thử.

Thì bạn viết 1 code cho nó paste Value, chẳng hạn:

Mã:

Sub Main()
  Dim wks As Worksheet, aData
  On Error Resume Next
  For Each wks In ThisWorkbook.Worksheets
    aData = wks.UsedRange.Value
    wks.UsedRange.Value = aData
  Next
End Sub

Chạy code xong, xóa luôn code rồi gửi

VetMini · 8/3/13

ndu96081631 đã viết:
Thì bạn copy paste value, xóa hết macro, công thức đi là được rồi
Đơn giản hơn nữa: Chuyển mọi thứ thành PDF (ví như bạn nói người ta chỉ cần đọc kết quả)

Thường thường thì báo cáo lên cấp cao nên chuyển qua PDF để tránh phiền phức - mấy sếp cấp cao không muốn click bị tùm lum dữ liệu. Chỉ có báo cáo cấp thấp mới giữ nguyên bản cho người đọc có cơ hội kiểm chứng dữ liệu nếu cần.

Cũng có khi người nhận cần bản dữ liệu dạng Excel để dùng vào việc khác - ví dụ gọp dữ liệu vào nơi khác, export qua CSDL khác vv... Trường hợp này bạn viết một hàm đơn giản trong file gốc. Hàm này "xổ" dữ liệu (tiếng chuyên nghiêp là spit) sang một văn bản khác, hoàn toàn sạch sẽ. Cái này nếu phải làm nhiều thì viết cho kỹ, export ra file bas để giành đó. Mỗi lần làm xong một văn bản thì import vào và "xổ" dữ liệu.

Hỏi nhanh - Đáp nhanh về macro (dành cho các thành viên mới học lập trình) (2 người xem)

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

Thành viên mới

Thành viên hoạt động

real women for private encounters

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

Huyền thoại GPE

Nguyễn Hoàng Nhi

Busy

Nguyễn Hoàng Nhi

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

Thành viên thường trực

Hướng tới tương lai

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

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

Busy

Huyền thoại GPE

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

Thành viên thường trực

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

Thành viên thường trực

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

Thành viên thường trực

File đính kèm

Huyền thoại GPE

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

Busy

File đính kèm

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

Busy

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

Huyền thoại GPE

Thành viên gắn bó

Đang đi tìm hòn đá

Huyền thoại GPE

Huyền thoại GPE

Thành viên gắn bó

Busy

File đính kèm

Thành viên gắn bó

Hướng tới tương lai

Thành viên gắn bó

Hướng tới tương lai

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

Huyền thoại GPE

Busy

File đính kèm

Nguyễn Khắc Duy

Busy

File đính kèm

Huyền thoại GPE

Busy

Huyền thoại GPE

Nguyễn Hoàng Nhi

Thành viên chính thức

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

Nguyễn Khắc Duy

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

File đính kèm

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

File đính kèm

Huyền thoại GPE

Thành viên chính thức

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

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Thành viên chính thức

File đính kèm

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

File đính kèm

Thành viên chính thức

Busy

Huyền thoại GPE

Busy

Thành viên gắn bó

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

Busy

Thành viên gắn bó