Giúp tạo list nhập dữ liệu trên ô sao cho dữ liệu chọn ở các ô không trùng nhau (1 người xem)

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

titanic20072007

Thành viên thường trực
Tham gia
10/7/07
Bài viết
217
Được thích
8
Nghề nghiệp
Giáo viên
Chào các bác. Hôm nay em có vấn đề bí quá muốn nhờ các bác giúp. Cụ thể như sau:
Mình có một dòng cần nhập mã từ 1->70. Mình muốn tạo một list trên ô cần nhập mã để khi kích vào ô đó nó hiện danh sách các mã để chọn. Nhưng các list này nó cứ cố định ở tất cả các ô nên có thể một mã lại được chọn nhiều hơn 1 lần (như vậy là không được). Mình muốn các bạn giúp làm sao để các giá trị ở list ô chọn sau đã bỏ đi các giá trị đã được chọn ơ những ô trước. Xin cảm ơn.
 

File đính kèm

Chào các bác. Hôm nay em có vấn đề bí quá muốn nhờ các bác giúp. Cụ thể như sau: Mình có một dòng cần nhập mã từ 1->70. Mình muốn tạo một list trên ô cần nhập mã để khi kích vào ô đó nó hiện danh sách các mã để chọn. Nhưng các list này nó cứ cố định ở tất cả các ô nên có thể một mã lại được chọn nhiều hơn 1 lần (như vậy là không được). Mình muốn các bạn giúp làm sao để các giá trị ở list ô chọn sau đã bỏ đi các giá trị đã được chọn ơ những ô trước. Xin cảm ơn.
chào bạn,
bạn test thử file Tạo list chọn mã giúp không bị trùng (1_1) , cho chạy Macro.

- chọn hoặc nhập trực tiếp mã tại row 7
- thêm, sửa, xóa mã tại cột A
-----> xem kết quả có đúng yêu cầu trên ko :-=

'- - -
code được kích hoạt ở 2 vị trí chính:
Private Sub Workbook_Open()
Private Sub Worksheet_Change(ByVal Target As Range) '(tại sheet1)

Link: https://www.mediafire.com/?b0d2xvkq72oxb91
 
Lần chỉnh sửa cuối:
Cảm ơn phucbugis. Mình đã test và thấy đúng như mình đang cần rồi. Tuy nhiên có một vấn đề phát sinh là khi mình chọn đến mã cuối cùng thì nó báo lỗi ở dòng .Add xlValidateList, , , Join(Dic.Keys, ",") 'add Data Validation
Bạn chỉnh lại hộ mình vơi nhé. Cảm ơn.
 
Bạn có thể sửa để cho các code này độc lập theo từng sheet được không vì mình có khoảng 20 sheet phải chọn mã như vậy. Vì mình thấy ở modul có lệnh
With Sheets("Sheet1")
ArrMax = .Range(.[A9], .[A65536].End(xlUp)) 'xac dinh du~ lieu cot ma~
Set Vung = .Range("C7:BT7")
Vậy nếu mình có 20 sheet như trên thì phải tạo 20 thủ tục như trên thì dài quá.
Dữ liệu cột mã của mình là cố định tối đa trong khoảng 70 mã thôi và luôn ở vị trí cố định ở các sheet.
 
Bạn có thể sửa để cho các code này độc lập theo từng sheet được không vì mình có khoảng 20 sheet phải chọn mã như vậy. Vì mình thấy ở modul có lệnh
With Sheets("Sheet1")
ArrMax = .Range(.[A9], .[A65536].End(xlUp)) 'xac dinh du~ lieu cot ma~
Set Vung = .Range("C7:BT7")
Vậy nếu mình có 20 sheet như trên thì phải tạo 20 thủ tục như trên thì dài quá.
Dữ liệu cột mã của mình là cố định tối đa trong khoảng 70 mã thôi và luôn ở vị trí cố định ở các sheet.

mình đã chỉnh xong lỗi ở #3 (đã up lại file 1_2 ở bài #2)

'----
còn nếu 20 sheet thì mình phải biết chính xác dữ liệu bố trí bên trong mỗi sheet nó ntn nữa, phải đồng nhất thì mới có thể gộp thành 1 Sub được.
bạn có thể up cái file đó lên được ko (nếu bất tiện thì share riêng cho 1 mình thôi --=0)
 
Lần chỉnh sửa cuối:
Mình gửi mẫu lên đây. G/s có 3 sheet và có thể phát sinh thêm trong khi sử dụng. Nếu phát sinh thêm thì khi copy sheet đã có trước đó rồi điển mã vào cột mã là có thể chạy được. Bạn nghiên cứu giúp mình nhé. Cảm ơn bạn.
 

File đính kèm

Mình gửi mẫu lên đây. G/s có 3 sheet và có thể phát sinh thêm trong khi sử dụng. Nếu phát sinh thêm thì khi copy sheet đã có trước đó rồi điển mã vào cột mã là có thể chạy được. Bạn nghiên cứu giúp mình nhé. Cảm ơn bạn.

bạn down tiếp file 1_3 và kiểm tra thử,

sau khi bạn copy thêm 1 sheet mới -> phải khai báo tên sheet mới này tại sheet 1 và click nút Update (để cập nhật Data Validation cho các mã của sheet mới đó)

Data Validation được kích hoạt khi:
Workbook_Open
Workbook_SheetChange (tất cả các sheet có tên trong sheet 1)

Link: https://www.mediafire.com/?mf7nchqqcv572en
 
Lần chỉnh sửa cuối:
Cách này chạy có vẻ phức tạp và khi copy xong sheet mới và chạy update ở sheet1 đôi lúc không đc. Mình thử bằng cách truyền tên sheet bạn xem có đc không.
 

File đính kèm

Cách này chạy có vẻ phức tạp và khi copy xong sheet mới và chạy update ở sheet1 đôi lúc không đc. Mình thử bằng cách truyền tên sheet bạn xem có đc không.

chắc do mình tính hơi xa --=0,

bạn kiểm tra tiếp file 5_1, mình đã làm theo yêu cầu trên là copy từng sheet ---> sự kiện Worksheet_Change đều có ở các sheet.

Sau khi copy sheet xong, nếu bố cục hàng cột có thay đổi --> bạn điều chỉnh 2 dòng sau ở Worksheet_Change
Set ArrMax = Range([A12], [A65536].End(xlUp))
Set ArrMaxchon = Range("E11:BV11")

còn Sub GPE_updatemax: nó dựa vào việc Set ở WS_change, bạn ko cần thay đổi ji cả.

'- - - -
sau này bạn muốn gộp chung các WS_change thì dùng Private Sub Workbook_SheetChange.

link: https://www.mediafire.com/?5n3girukqlswo14
 
Lần chỉnh sửa cuối:
Chào các bác. Hôm nay em có vấn đề bí quá muốn nhờ các bác giúp. Cụ thể như sau:
Mình có một dòng cần nhập mã từ 1->70. Mình muốn tạo một list trên ô cần nhập mã để khi kích vào ô đó nó hiện danh sách các mã để chọn. Nhưng các list này nó cứ cố định ở tất cả các ô nên có thể một mã lại được chọn nhiều hơn 1 lần (như vậy là không được). Mình muốn các bạn giúp làm sao để các giá trị ở list ô chọn sau đã bỏ đi các giá trị đã được chọn ơ những ô trước. Xin cảm ơn.

góp vui thêm cách làm bằng cthức, nhưng nó ko được như vba, mỗi lần chuyển dòng chịu khó nhấn delete,,,,,,,,,nó mới reset lại danh sách.........--=0
 

File đính kèm

góp vui thêm cách làm bằng cthức, nhưng nó ko được như vba, mỗi lần chuyển dòng chịu khó nhấn delete,,,,,,,,,nó mới reset lại danh sách.........--=0
Cách của bạn có vấn đề là khi mình xóa đi một số mã thì list không thay đổi (mình thấy ở cột B nó vẫn hiện từ 1->70). Và nếu chọn xong làm việc khác lúc sau chọn tiếp thì số số đầu tiên của list là số 1 mặc dù số 1 được chọn đầu tiên rồi. Bạn có thể sửa lại được không?
 
chắc do mình tính hơi xa --=0,

bạn kiểm tra tiếp file 5_1, mình đã làm theo yêu cầu trên là copy từng sheet ---> sự kiện Worksheet_Change đều có ở các sheet.

Sau khi copy sheet xong, nếu bố cục hàng cột có thay đổi --> bạn điều chỉnh 2 dòng sau ở Worksheet_Change
Set ArrMax = Range([A12], [A65536].End(xlUp))
Set ArrMaxchon = Range("E11:BV11")

còn Sub GPE_updatemax: nó dựa vào việc Set ở WS_change, bạn ko cần thay đổi ji cả.

'- - - -
sau này bạn muốn gộp chung các WS_change thì dùng Private Sub Workbook_SheetChange.

Cảm ơn bạn. Mình đang test và chưa thấy vấn đề gì. Sao mình sửa vùng Set ArrMax = Range([A12], [A65536].End(xlUp)) thành Set ArrMax = Range([A12], [A81].End(xlUp)) nó lại không chạy là sao?
 
chắc do mình tính hơi xa --=0,

bạn kiểm tra tiếp file 5_1, mình đã làm theo yêu cầu trên là copy từng sheet ---> sự kiện Worksheet_Change đều có ở các sheet.

Sau khi copy sheet xong, nếu bố cục hàng cột có thay đổi --> bạn điều chỉnh 2 dòng sau ở Worksheet_Change
Set ArrMax = Range([A12], [A65536].End(xlUp))
Set ArrMaxchon = Range("E11:BV11")

còn Sub GPE_updatemax: nó dựa vào việc Set ở WS_change, bạn ko cần thay đổi ji cả.

'- - - -
sau này bạn muốn gộp chung các WS_change thì dùng Private Sub Workbook_SheetChange.

CHo mình hỏi sao mình sửa A65536 thành A81 (vì vùng chứa mã tối đa chỉ tời ô A81) nhưng sao lệnh không chạy? Bạn giải thích giúp được không?
 
CHo mình hỏi sao mình sửa A65536 thành A81 (vì vùng chứa mã tối đa chỉ tời ô A81) nhưng sao lệnh không chạy? Bạn giải thích giúp được không?

do copy code trên file của bạn nên mới bị vậy --=0, mình ko để ý là bạn đã chỉnh lại code

đúng phải là Set ArrMax = Range([A65536].End(xlUp), [A12])

'- - -
nếu bạn cài thành Range([A81].End(xlUp), [A12]) ---> có thể xảy ra lỗi vì A81 đang nằm trong vùng chứa dữ liệu --> phải xác định 1 ô nằm ngoài vùng dữ liệu thì xlUp mới có tác dụng (bởi vậy dùng row 65536 là khá an toàn :-=)

bạn thử với lệnh Range([A81].End(xlUp), [A12]).select thì sẽ thấy điều đó.
 
Lần chỉnh sửa cuối:
Trong tệp bạn gửi mình thấy Set ArrMax = Range([A12], [A65536].End(xlUp) có phải là tạo list mã trong vùng từ ô A12 đến A65536 không?
 
Trong tệp bạn gửi mình thấy Set ArrMax = Range([A12], [A65536].End(xlUp) có phải là tạo list mã trong vùng từ ô A12 đến A65536 không?

'- - -
- ko phải vậy, nó chỉ thêm các mã có trong vùng từ A12 đến A81 thôi
- bạn kiểm tra Data Validation của các ô thuộc row mã chọn thì sẽ thấy các giá trị đã add vào ô đó.

đoạn code trên mình đã sửa lại thành Set ArrMax = Range([A65536].End(xlUp), [A12]) (bạn tải lại file 1_5_1 ở #9)
 
Lần chỉnh sửa cuối:
Cách của bạn có vấn đề là khi mình xóa đi một số mã thì list không thay đổi (mình thấy ở cột B nó vẫn hiện từ 1->70). Và nếu chọn xong làm việc khác lúc sau chọn tiếp thì số số đầu tiên của list là số 1 mặc dù số 1 được chọn đầu tiên rồi. Bạn có thể sửa lại được không?

cái list thì do tôi tự tạo ra nên bạn sửa nó ko được là phải rồi...hihihi--=0.........vào name bạn sẻ thấy
còn cái dzụ reset lại danh sách thì khi chuyển dòng phải nhấn delete mà..........tui nói rùi..........hihihi..--=0
nói chớ làm cho vui thôi, chó nó bật tiện,,,,,,,,,,,
bon chen theo bạn Phucbugis làm thử bằng vba,,,,,,,,tôi mới tập tành thui........hihihi
 

File đính kèm

cái list thì do tôi tự tạo ra nên bạn sửa nó ko được là phải rồi...hihihi--=0.........vào name bạn sẻ thấy
còn cái dzụ reset lại danh sách thì khi chuyển dòng phải nhấn delete mà..........tui nói rùi..........hihihi..--=0
nói chớ làm cho vui thôi, chó nó bật tiện,,,,,,,,,,,
bon chen theo bạn Phucbugis làm thử bằng vba,,,,,,,,tôi mới tập tành thui........hihihi

- mới tập tành mà viết dzữ quá --=0
- bạn mà cài sự kiện Workbook_SheetSelectionChange ---> nó ảnh hưởng đến các sheet khác.
- khi gộp chung --> có 1 cài bất tiện: 1 trong các sheet (T1, T2, ...) có bộ cục hơi khác 1 tí là ko dùng được.
 
- mới tập tành mà viết dzữ quá --=0
- bạn mà cài sự kiện Workbook_SheetSelectionChange ---> nó ảnh hưởng đến các sheet khác.
- khi gộp chung --> có 1 cài bất tiện: 1 trong các sheet (T1, T2, ...) có bộ cục hơi khác 1 tí là ko dùng được.

có biết đâu nè,,,, tưởng là các sheet giống nhau hết, nếu vậy thì muốn xài sheet nào thì copy vô sheet đó...............--=0
 
Lần chỉnh sửa cuối:
chắc do mình tính hơi xa --=0,

bạn kiểm tra tiếp file 5_1, mình đã làm theo yêu cầu trên là copy từng sheet ---> sự kiện Worksheet_Change đều có ở các sheet.

Sau khi copy sheet xong, nếu bố cục hàng cột có thay đổi --> bạn điều chỉnh 2 dòng sau ở Worksheet_Change
Set ArrMax = Range([A12], [A65536].End(xlUp))
Set ArrMaxchon = Range("E11:BV11")

còn Sub GPE_updatemax: nó dựa vào việc Set ở WS_change, bạn ko cần thay đổi ji cả.

'- - - -
sau này bạn muốn gộp chung các WS_change thì dùng Private Sub Workbook_SheetChange.

phucbugis ơi xem lại hộ mình nếu chọn bằng chuột thì ok còn nếu nhập thì nó không kiểm soát được sự trùng với mã đã có.
 
phucbugis ơi xem lại hộ mình nếu chọn bằng chuột thì ok còn nếu nhập thì nó không kiểm soát được sự trùng với mã đã có.

cho mình hỏi,

các ô thuộc row mã chọn: số liệu nhập vào có được phép trùng nhau ko?

'- - -
trong Sub GPE_updatemax bạn để ý đoạn đỏ đỏ

Mã:
    For Each Rng In vung2
        With Rng.Validation
            .Delete
            On Error Resume Next                                        'khi ma~ cuoi'
            .Add xlValidateList, , , Join(Dic.Keys, ",")                'add Data Validation
[COLOR=#FF0000]            .ShowError = False                                          'cho phep nhap truc tiep ma~ trung[/COLOR]
        End With
    Next
 
Lần chỉnh sửa cuối:
có biết đâu nè,,,, tưởng là các sheet giống nhau hết, nếu vậy thì muốn xài sheet nào thì copy vô sheet đó...............--=0
Không trong trường hợp của mình thì các sheet giống nhau tuyệt đối. Cách của bạn rất gọn và tối ưu hơn thì phải mình vẫn đang test. Cảm ơn. Có gì sẽ nhờ tiếp.
 
có biết đâu nè,,,, tưởng là các sheet giống nhau hết, nếu vậy thì muốn xài sheet nào thì copy vô sheet đó...............--=0

Cho mình hỏi một chút. Vì phát sinh vấn đề mới nên mình phải thiết kế lại bảng dữ liệu đó là bổ sung thêm vào bên phải mỗi ô chọn mã một ô trống cho nên vùng để chọn mã và kiểm soát mã trùng tăng lên gấp đôi từ 74 lên 144. Mình đã chỉnh lại phạm vi nhưng không hiểu sao nó không hiện list đầy đủ và kiểm soát mã được. Bạn có thể giúp mình được không?
Sub AddValidationList()
Dim Sarr, ReadyArr As Variant, RemainArr(), Dic As Object, list As String
Sarr = ActiveSheet.[a12:a81].Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim RemainArr(1 To UBound(Sarr), 1 To 1)
For Each CLL In Cells(ActiveCell.Row, 5).Resize(, 144)
If Not IsEmpty(CLL) Then Dic.Add CLL.Value, ""
Next
K = 1
For I = 1 To UBound(Sarr)
If Not Dic.Exists(Sarr(I, 1)) Then
RemainArr(K, 1) = Sarr(I, 1)
K = K + 1
End If
Next
list = Join(Application.WorksheetFunction.Transpose(RemainArr), ",")
With ActiveCell.Validation
.Delete
.Add 3, , , list
.IgnoreBlank = True
End With
Set Dic = Nothing
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Cho mình hỏi một chút. Vì phát sinh vấn đề mới nên mình phải thiết kế lại bảng dữ liệu đó là bổ sung thêm vào bên phải mỗi ô chọn mã một ô trống cho nên vùng để chọn mã và kiểm soát mã trùng tăng lên gấp đôi từ 74 lên 144. Mình đã chỉnh lại phạm vi nhưng không hiểu sao nó không hiện list đầy đủ và kiểm soát mã được. Bạn có thể giúp mình được không?

bạn vào ThisWorkbook, bạn thấy đoạn code sau:
Mã:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Application.EnableEvents = True
If Not Intersect(Target, [e11:[COLOR=#ff0000]bv17[/COLOR]]) Is Nothing And Target.Count = 1 Then AddValidationList
End Sub
bạu sửa BV thành EM, và 17 thành dòng bao nhieu mà bạn muốn

nhân tiên bạn sửa lại đoạn code này một chút
chớ viết kiểu cũ thấy giống SangYang lên đời....hihihih .........(cái này mới hỏi anh Hoàng Trọng Nghĩa hôm qua)

Mã:
Sub AddValidationList()
'Application.EnableEvents = True

Dim Sarr, ReadyArr As Variant, RemainArr(), dic As Object, list As String

Sarr = ActiveSheet.[a12:a81].Value
ReadyArr = Cells(ActiveCell.Row, 5).Resize(, [COLOR=#ff0000]139[/COLOR]).Value
Set dic = CreateObject("Scripting.Dictionary")
ReDim RemainArr(1 To UBound(Sarr), 1 To 1)

    [COLOR=#0000ff]For i = 1 To UBound(ReadyArr, 2)
        If Not IsEmpty(ReadyArr(1, i)) Then dic.Add ReadyArr(1, i), ""
    Next[/COLOR]
      
    K = 1
    For i = 1 To UBound(Sarr)
        If Not dic.Exists(Sarr(i, 1)) Then
            RemainArr(K, 1) = Sarr(i, 1)
            
            K = K + 1
        End If
    Next

list = Join(Application.WorksheetFunction.Transpose(RemainArr), ",")
    
With ActiveCell.Validation
.Delete
.Add 3, , , list
.IgnoreBlank = True
End With
Set dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Mã:
Sub AddValidationList()
'Application.EnableEvents = True

Dim Sarr, ReadyArr As Variant, RemainArr(), dic As Object, list As String

Sarr = ActiveSheet.[a12:a81].Value
ReadyArr = Cells(ActiveCell.Row, 5).Resize(, [COLOR=#ff0000]139[/COLOR]).Value
Set dic = CreateObject("Scripting.Dictionary")
[COLOR=#ff0000]ReDim RemainArr(1 To UBound(Sarr), 1 To 1)[/COLOR]

    [COLOR=#0000ff]For i = 1 To UBound(ReadyArr, 2)
        If Not IsEmpty(ReadyArr(1, i)) Then dic.Add ReadyArr(1, i), ""
    Next[/COLOR]
      
    K = 1
    For i = 1 To UBound(Sarr)
        If Not dic.Exists(Sarr(i, 1)) Then
           [COLOR=#ff0000] RemainArr(K, 1) = Sarr(i, 1)[/COLOR]
            
            K = K + 1
        End If
    Next

list = Join([COLOR=#ff0000]Application.WorksheetFunction.Transpose(RemainArr)[/COLOR], ",")
    
With ActiveCell.Validation
.Delete
.Add 3, , , list
.IgnoreBlank = True
End With
Set dic = Nothing
End Sub

Chỗ màu đỏ: Tại sao lại dùng MÀNG 2 CHIỀU để phải mất công "làm phiền" đến WorksheetFunction.Transpose vậy?
 
Chỗ màu đỏ: Tại sao lại dùng MÀNG 2 CHIỀU để phải mất công "làm phiền" đến WorksheetFunction.Transpose vậy?

nhiều khi thấy người khác làm thì bắt chướt làm theo chứ chưa hiểu được hết.............hichic.
bi giờ thì hiểu thêm một cái nữa........hihihi

anh cho hỏi thêm chổ này một chút

tôi có một cái mảng nguồn là SArr
và mảng kết quả là KQ
Redim KQ(1 to ubound(SArr))
rồi dùng vòng lặp để nạp từ mảng nguồn qua mảng kết quả theo điều kiện.
giống như trường hợp bên trên.

khi mình sử dụng hàm: Joint(QK,",") để nạp vào validation thì thấy nó dư dấu "," rất nhiều.
nhiều khi nó nhiều đến mức mà ko nạp vào validation được luôn.

khi đó tôi phải giới hạn cái mảng KQ lại thí dụ Redim KQ(1 to 100).

trong trường hợp này thì phải xử lý sao vậy anh?

cám ơn
 
nhiều khi thấy người khác làm thì bắt chướt làm theo chứ chưa hiểu được hết.............hichic.
bi giờ thì hiểu thêm một cái nữa........hihihi

anh cho hỏi thêm chổ này một chút

tôi có một cái mảng nguồn là SArr
và mảng kết quả là KQ
Redim KQ(1 to ubound(SArr))
rồi dùng vòng lặp để nạp từ mảng nguồn qua mảng kết quả theo điều kiện.
giống như trường hợp bên trên.

khi mình sử dụng hàm: Joint(QK,",") để nạp vào validation thì thấy nó dư dấu "," rất nhiều.
nhiều khi nó nhiều đến mức mà ko nạp vào validation được luôn.

khi đó tôi phải giới hạn cái mảng KQ lại thí dụ Redim KQ(1 to 100).

trong trường hợp này thì phải xử lý sao vậy anh?

cám ơn

Như bạn đã nói:
dùng vòng lặp để nạp từ mảng nguồn qua mảng kết quả theo điều kiện
Vậy có nghĩa là mảng KQ phải ít phần tử hơn mảng SArr, đúng không?
Trong khi đó bạn lại Redim KQ(1 to ubound(SArr)), tức bạn đã tạo 2 mảng bằng nhau. Vậy mảng KQ bị thừa là phải rồi
Trong trường hợp này người dùng ReDiim Preserve
Ví dụ
Mã:
Dim i as Long, n as Long
Dim tmp as String
Dim SArr, KQ()
'......................... 
For i = LBound(SArr) to UBound(SArr)
  If <Điều kiện gì đó> Then
    n = n + 1
    [COLOR=#ff0000]ReDim Preserve KQ(1 to n)[/COLOR]
    KQ(n) = SArr(i)
  End If
Next
If n then tmp = Join(KQ, ", ")
Đại khái thế!
Chỗ màu đỏ nghĩa là điều kiện đến đâu ta mở rộng mảng đến nấy. Vậy thì số phần tử luôn lắp đầy mảng KQ, sẽ không có chuyện dư thừa (mà khi dùng Join sẽ phát hiện ra)
 
bạn vào ThisWorkbook, bạn thấy đoạn code sau:
Mã:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Application.EnableEvents = True
If Not Intersect(Target, [e11:[COLOR=#ff0000]bv17[/COLOR]]) Is Nothing And Target.Count = 1 Then AddValidationList
End Sub
bạu sửa BV thành EM, và 17 thành dòng bao nhieu mà bạn muốn
[/code]

Cho mình hỏi thêm một chút. Mình thấy list trên nó có ở tất cả các sheet của tệ, nếu mình muốn một số sheet nào đó không áp dụng list thì mình thêm lệnh như thế nào? (vì mình có một vài sheet chứa thông tin chung nhưng nó cứ hiện list ở dòng 11).
 
Cho mình hỏi thêm một chút. Mình thấy list trên nó có ở tất cả các sheet của tệ, nếu mình muốn một số sheet nào đó không áp dụng list thì mình thêm lệnh như thế nào? (vì mình có một vài sheet chứa thông tin chung nhưng nó cứ hiện list ở dòng 11).

tôi chưa test, bạn thử nha
ví dụ bạn chỉ muốn 1 sheet ko thực hiện
Mã:
if sheet.name="giđó" then exit sub
hoặc bạn có 10 sheet, bạn chỉ muốn nó thực hiện từ 1-9
Mã:
if sheet.count<10 then cho chạy code của bạn
 
bạn vào ThisWorkbook, bạn thấy đoạn code sau:
Mã:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Application.EnableEvents = True
If Not Intersect(Target, [e11:[COLOR=#ff0000]bv17[/COLOR]]) Is Nothing And Target.Count = 1 Then AddValidationList
End Sub
bạu sửa BV thành EM, và 17 thành dòng bao nhieu mà bạn muốn
Bạn cho mình hỏi một chút. Đoạn code trên nó luôn tạo và kiểm tra trong vùng e11:bv11 list mã, nhưng vì mình muốn tạo một sheet lươ thông tin chung cho tệp thì nó cũng hiện list ở đây. Có cách nào để nó bỏ qua một hay vài sheet cụ thể nào đó không. Cảm ơn bạn.
 
Bạn cho mình hỏi một chút. Đoạn code trên nó luôn tạo và kiểm tra trong vùng e11:bv11 list mã, nhưng vì mình muốn tạo một sheet lươ thông tin chung cho tệp thì nó cũng hiện list ở đây. Có cách nào để nó bỏ qua một hay vài sheet cụ thể nào đó không. Cảm ơn bạn.

bạn thử theo bài #32, nếu ko được thì đưa file lên tôi thử lại cho bạn
 
Bạn xem chỉnh giúp mình với. Mình đã làm như #32 rồi nhưng không được.

Mã:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
   [COLOR=#0000ff] 'If ActiveSheet.Name = "Thong tin" Or ActiveSheet.Name = "Tong hop" Then Exit Sub 'theo tên
        If ActiveSheet.Index = 1 Or ActiveSheet.Index = 3 Then Exit Sub ' theo thu tu[/COLOR]

    If Not Intersect(Target, [e11:bv11]) Is Nothing And Target.Count = 1 Then AddValidationList
End Sub

bạn lấy một trong 2 dòng code màu xanh
 
Mã:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
   [COLOR=#0000ff] 'If ActiveSheet.Name = "Thong tin" Or ActiveSheet.Name = "Tong hop" Then Exit Sub 'theo tên
        If ActiveSheet.Index = 1 Or ActiveSheet.Index = 3 Then Exit Sub ' theo thu tu[/COLOR]

    If Not Intersect(Target, [e11:bv11]) Is Nothing And Target.Count = 1 Then AddValidationList
End Sub

bạn lấy một trong 2 dòng code màu xanh

Vẫn còn một số ô trong vùng E11:I11 và E13 ở sheet Tong hop và E11:G11 và E13:E14 ở sheet Thong tin. Bạn xem chỉnh lại hộ mình với.
 

File đính kèm

Lần chỉnh sửa cuối:
Vẫn còn một số ô trong vùng E11:I11 và E13 ở sheet Tong hop và E11:G11 và E13:E14 ở sheet Thong tin. Bạn xem chỉnh lại hộ mình với.

tại vì nó đã được tạo ra từ trước rồi, bi giờ ko xài nữa thì fải xoá đi (code chỉ giúp ko tạo ra cái mới)
chọn nguyên hàng 11-->validation--->chọn any value
sau đó di chuyển trên hàng 11 xem nó có tạo ra cái list mới ko
 
Lần chỉnh sửa cuối:
Đúng rồi.
Bạn cho mình hỏi. Tệp của mình ngòi hai sheet Thong tin va Tong hop thì còn có các sheet dữ liệu (có cấu trúc giống hệt nhau) nhưng lại không biết là nó có bao nhiêu sheet. Vậy nếu mình muốn tổng hợp thì có làm như thế nào? Bằng công thức hay code?
 
Đúng rồi.
Bạn cho mình hỏi. Tệp của mình ngòi hai sheet Thong tin va Tong hop thì còn có các sheet dữ liệu (có cấu trúc giống hệt nhau) nhưng lại không biết là nó có bao nhiêu sheet. Vậy nếu mình muốn tổng hợp thì có làm như thế nào? Bằng công thức hay code?

làm bằng gì cũng được, nhưng bạn đã biết vba thì xài vba luôn (nó mạnh hơn cthức nhiều)
thì dụ bạn muốn lặp qua các sheet
Mã:
For i = 1 To Sheets.Count
'code ban o day
Next
 
làm bằng gì cũng được, nhưng bạn đã biết vba thì xài vba luôn (nó mạnh hơn cthức nhiều)
thì dụ bạn muốn lặp qua các sheet
Mã:
For i = 1 To Sheets.Count
'code ban o day
Next

Mình mới làm quen với vba thôi chưa hiểu nhiều về nó. Sheets.Count có phải là số lượng sheet của tệp không? Nhưng vấn đề là trong tệp có 2 sheet không chứa dữ liệu còn các sheet khác chứa dữ liệu thì loại bỏ 2 sheet kia ra như thế nào? Vấn đề mình đang tổng hợp thì mình chưa tìm ra hướng vì nó lằng nhằng quá. Bạn giúp mình với nhé.
 
Mình mới làm quen với vba thôi chưa hiểu nhiều về nó. Sheets.Count có phải là số lượng sheet của tệp không? Nhưng vấn đề là trong tệp có 2 sheet không chứa dữ liệu còn các sheet khác chứa dữ liệu thì loại bỏ 2 sheet kia ra như thế nào? Vấn đề mình đang tổng hợp thì mình chưa tìm ra hướng vì nó lằng nhằng quá. Bạn giúp mình với nhé.

đúng rồi sheet.count là số sheet có trong file của bạn

thì làm như bài #33 hay #34 gì đó, tức thêm if vào
"nếu sheet tên đó thì ko làm"
bạn đưa file lên, muốn tổng hợp cái gì, cho vi dụ...........tôi sẻ làm thử
 

File đính kèm

Mình gửi tệp dữ liệu với yêu cầu và giải thích cụ thể bên trong bạn xem giúp mình ở trang Thong bao nhé. Cảm ơn bạn nhiều.

các sheet T01-T04 của bạn hầu hết tháng 05 bị gõ sai tháng (vi du như 25/25/2014),,,,tôi mất khá nhiều thời gian để tìm cho sai..............phìphì.........@!##

bạn xem được chư nha
Mã:
Sub loc()
Dim Ng As Variant, KQ(), i, j, k, m As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheet7.[A7:K1000].EntireRow.Delete
For Each ws In ThisWorkbook.Worksheets
l = ws.Index
k = 0
If ws.Index <> 1 Then
If ws.Index <> 6 Then 'toi ko biet vi sao 2 dieu kien nay ko the ket hop bang ham or?
With ws
Ng = .[a9].Resize(.[a1000].End(3).Row, .[iv9].End(1).Column).Value
ReDim KQ(1 To UBound(Ng), 1 To 8)
For i = 1 To UBound(Ng)
    If Ng(i, 2) = Sheet7.[D2].Value Then
        For j = 1 To UBound(Ng, 2) Step 2
            If DateSerial(Year(Ng(1, j)), Month(Ng(1, j)), Day(Ng(1, j))) <= DateSerial(Year(Sheet7.[d4]), Month(Sheet7.[d4]), Day(Sheet7.[d4])) Then
                If IsEmpty(Ng(i, j + 1)) Then
                    k = k + 1
                    m = m + 1
                    KQ(k, 1) = m 'stt
                    KQ(k, 2) = ws.Name 'ten nhom
                    KQ(k, 3) = Ng(1, j) 'ngay
                    KQ(k, 4) = Ng(i, 3) 'ten
                    KQ(k, 5) = Ng(2, j) 'gia tri
                    KQ(k, 6) = ws.[c1] 'so tien chiet khau
                    KQ(k, 7) = Ng(i, j) 'so tien phai nop
                End If
            End If
        Next j
    End If
Next i
End With
If k Then Sheet7.[a1000].End(3).Offset(1).Resize(k, 7).Value = KQ
End If
End If
Next 'ws
With [a7].Resize([a7].End(4).Row, 8)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Cảm ơn bạn mình đang test.
Lệnh
If ws.Index <> 1 Then
If ws.Index <> 6 Then 'toi ko biet vi sao 2 dieu kien nay ko the ket hop bang ham or?
để kiểm tra gì vậy?
 
Lần chỉnh sửa cuối:
Cảm ơn bạn mình đang test.
Lệnh
If ws.Index <> 1 Then
If ws.Index <> 6 Then 'toi ko biet vi sao 2 dieu kien nay ko the ket hop bang ham or?
để kiểm tra gì vậy?

sheet số 1 là sheet "thong tin" sheet số 6 là sheet "loc"
ở trên là vòng lặp qua các sheet, nếu nó ko phải là sheet số 1 và 6 thì tiếp tục thực hiện
========
theo đúng thì viết như vậy
Mã:
If (ws.Index <> 1) Or (ws.Index <> 6) Then
nhưng giống có ma ám vậy test hoài ko được (ko biết là lổi gì, thông thường tôi vẩn viết như vậy??????????)
 
Sao code mình viết chạy trên một sheet thì ok. Nhưng khi đưa vào chạy cho các sheet thì chạy vô hạn. Chắc là do mình chua biết thao tác chuyển qua các sheet, và tìm được ai thì cho hiện ra luôn trang thông báo nen hơi chạm. Bạn đọc xem sao nhé?
Mã:
Sub Test1()
Dim Arr As Variant, Ws As Worksheet
ReDim Arr(1 To 74, 1 To 144)
dem = 0
hanghd = 10 'hang dau tien de chua du lieu trong thong bao
For Each Ws In ThisWorkbook.Worksheets
    If (UCase(Ws.Name) <> "He thong") And (UCase(Ws.Name) <> "Tem") And (UCase(Ws.Name) <> "Hoa don") Then
        ma = Cells(5, 5)
        ngaytinh = Cells(7, 10)
        giaho = Ws.Cells(1, 4)
        MsgBox "UCase(Ws.Name): " & UCase(Ws.Name)
        hang = 1
        Arr = Ws.Range("A8:EN81").Value    'nap vung du lieu vao mang
        For I = 1 To 74
            If Arr(I, 2) = ma Then ' neu gap ma can tim MsgBox Arr(I, 2)
                For J = 5 To 144 Step 2 ' duyet tung thang
                    If Arr(hang + 1, J) <= ngaytinh Then 'neu ngay thang dang xet nho hon hoac bang ngay tinh
                        If Arr(I, J + 1) <> "x" Then 'neu chua nop
                            mua = Arr(hang + 2, J)
                            For K = 1 To 74 'duyet tim ten nguoi mua
                                If Arr(K, 1) = Arr(hang + 3, J) Then nguoimua = Arr(K, 3) 'lay ten nguoi mua
                            Next K
                            phainop = Arr(I, J)
                            Cells(hanghd + dem, 9) = mua
                            Cells(hanghd + dem, 4) = nguoimua
                            Cells(hanghd + dem, 10) = phainop
                            Cells(hanghd + dem, 8) = giaho
                            Cells(hanghd + dem, 3) = Arr(hang + 1, J) ' thang chua nop
                            dem = dem + 1
                        End If
                    End If
                Next J
            End If
        Next I
    End If
Next
End Sub
 
sheet số 1 là sheet "thong tin" sheet số 6 là sheet "loc"
ở trên là vòng lặp qua các sheet, nếu nó ko phải là sheet số 1 và 6 thì tiếp tục thực hiện
========
theo đúng thì viết như vậy
Mã:
If (ws.Index <> 1) Or (ws.Index <> 6) Then
nhưng giống có ma ám vậy test hoài ko được (ko biết là lổi gì, thông thường tôi vẩn viết như vậy??????????)
Trong book làm gì có sheet 6 và mình nghĩ phải and mới phải
 
Bạn có thể sửa lại để khi đưa kq ra trang thông báo nó không được xóa ngoài phạm vi của các bảng đã kẻ lúc trước không. ì cuối bảng còn có mấy công thức tính tổng và đổi số ra chữ nữa.
 
Bạn có thể sửa lại để khi đưa kq ra trang thông báo nó không được xóa ngoài phạm vi của các bảng đã kẻ lúc trước không. ì cuối bảng còn có mấy công thức tính tổng và đổi số ra chữ nữa.

Mã:
Sub loc()
Dim Ng As Variant, KQ(), i, j, k, m As Long
Dim Ws As Worksheet
Application.ScreenUpdating = False
[COLOR=#ff0000]Sheet7.[A7:K1000].EntireRow.Delete[/COLOR]
For Each Ws In ThisWorkbook.Worksheets
l = Ws.Index
k = 0
If Ws.Index <> 1 Then
If Ws.Index <> 6 Then 'toi ko biet vi sao 2 dieu kien nay ko the ket hop bang ham or?
With Ws
Ng = .[a9].Resize(.[a1000].End(3).Row, .[iv9].End(1).Column).Value
ReDim KQ(1 To UBound(Ng), 1 To 8)
For i = 1 To UBound(Ng)
    If Ng(i, 2) = Sheet7.[D2].Value Then
        For j = 1 To UBound(Ng, 2) Step 2
            If DateSerial(Year(Ng(1, j)), Month(Ng(1, j)), Day(Ng(1, j))) <= DateSerial(Year(Sheet7.[d4]), Month(Sheet7.[d4]), Day(Sheet7.[d4])) Then
                If IsEmpty(Ng(i, j + 1)) Then
                    k = k + 1
                    m = m + 1
                    KQ(k, 1) = m 'stt
                    KQ(k, 2) = Ws.Name 'ten nhom
                    KQ(k, 3) = Ng(1, j) 'ngay
                    KQ(k, 4) = Ng(i, 3) 'ten
                    KQ(k, 5) = Ng(2, j) 'gia tri
                    KQ(k, 6) = Ws.[c1] 'so tien chiet khau
                    KQ(k, 7) = Ng(i, j) 'so tien phai nop
                    [COLOR=#0000ff]giatri = giatri + KQ(k, 5)
                    sotien = sotien + KQ(k, 6)
                    stphainop = stphainop + KQ(k, 7)[/COLOR]
                End If
            End If
        Next j
    End If
Next i
End With
If k Then Sheet7.[a1000].End(3).Offset(1).Resize(k, 7).Value = KQ
End If
End If
Next 'ws
[COLOR=#0000cd][a10000].End(3).Offset(1, 3) = " Tong"
[a10000].End(3).Offset(1, 4) = giatri
[a10000].End(3).Offset(1, 5) = sotien
[a10000].End(3).Offset(1, 6) = stphainop[/COLOR]
With [a7].Resize([a10000].End(3).Row - 5, 8)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlHairline
    End With
Application.ScreenUpdating = True
End Sub


2 cách
- bạn muốn xoá bao nhiêu dòng thì chỉnh lại dòng màu đỏ ở trên, đổi ".delete" thành ".clearcontents"
nhưng với cách này thì bạn làm sao biết kết quả của bạn có bao nhiêu dòng mà bạn để dành?
-cách 2: thêm các dòng màu xanh
bạn cho hỏi hàm đổi chữ thành số của bạn là hàm tự tạo (vba) hay các hàm excel?
 
Mã:
có 
2 cách
- bạn muốn xoá bao nhiêu dòng thì chỉnh lại dòng màu đỏ ở trên, đổi ".delete" thành ".clearcontents"
nhưng với cách này thì bạn làm sao biết kết quả của bạn có bao nhiêu dòng mà bạn để dành?
-cách 2: thêm các dòng màu xanh
bạn cho hỏi hàm đổi chữ thành số của bạn là hàm tự tạo (vba) hay các hàm excel?[/QUOTE]
Mình sử dụng một hàm vba trên GPE mà
 
sheet số 1 là sheet "thong tin" sheet số 6 là sheet "loc"
ở trên là vòng lặp qua các sheet, nếu nó ko phải là sheet số 1 và 6 thì tiếp tục thực hiện
========
theo đúng thì viết như vậy
Mã:
If (ws.Index <> 1) Or (ws.Index <> 6) Then
nhưng giống có ma ám vậy test hoài ko được (ko biết là lổi gì, thông thường tôi vẩn viết như vậy??????????)

2 đk kết hợp bằng OR???

Phân tích code thì ra thôi.

Mã:
Những code khác
[COLOR=#0000ff]If ws.Index <> 1 Then[/COLOR]
    [COLOR=#ff0000]If ws.Index <> 6 Then 'toi ko biet vi sao 2 dieu kien nay ko the ket hop bang ham or?
       [/COLOR] làm cái gì đấy[COLOR=#ff0000]
    End If[/COLOR]
    các code khác
[COLOR=#0000ff]End If[/COLOR]
Những code khác.

Muốn "làm cái gì đấy" được thực hiện thì đk ws.Index <> 6 phải thỏa, tức ws.Index <> 6 = TRUE. Nhưng muốn "làm cái gì đấy" được thực hiện thì bản thân cụm đỏ đỏ phải được thực hiện. Mà cụm đỏ đỏ được thực hiện khi và chỉ khi cụm xanh xanh được thực hiện. Tức khi và chỉ khi đk ws.Index <> 1 thỏa, tức ws.Index <> 1 = TRUE

Vậy muốn kết hợp thì phải dùng toán tử AND: ws.Index <> 1 = TRUE VÀ ws.Index <> 6 = TRUE
 
Lần chỉnh sửa cuối:
Cho mình hỏi làm thế nào để vẫn chọn được giá trị trong list của ô chứa ValidationList tạo bằng vba trong tệp khi đặt pass bảo vệ công thức?
 

File đính kèm

Cho mình hỏi làm thế nào để vẫn chọn được giá trị trong list của ô chứa ValidationList tạo bằng vba trong tệp khi đặt pass bảo vệ công thức?

bạn xem rồi tùy biến, mấy cái dzụ pro...pro..tect..tect này tôi ko có rành.

mà xài vba thì xài hết luôn,,,,,,,,xài cthức làm chi?
 

File đính kèm

bạn xem rồi tùy biến, mấy cái dzụ pro...pro..tect..tect này tôi ko có rành.

mà xài vba thì xài hết luôn,,,,,,,,xài cthức làm chi?
Nhiều chỗ mình chưa biết dùng vba như thế nào và nếu mình dùng thì không có vđ gì nhưng người khác dùng sợ sơ ý họ làm thay đổi các định dạng của bảng biếu không thống nhất.
Cách của bạn là như vậy là nó sẽ khóa tất các ô mà mình muốn chỉ khóa một số cột còn một số cột vẫn phải để nhập dl.
Bạn là người hiểu code nhất mình nghĩ bạn sẽ có cách mà:
Mã:
Sub AddValidationList()
Dim Sarr, ReadyArr As Variant, RemainArr(), dic As Object, list As String
Sarr = ActiveSheet.[a12:a81].Value
Set dic = CreateObject("Scripting.Dictionary")
ReDim RemainArr(1 To UBound(Sarr), 1 To 1)
    For Each CLL In Cells(ActiveCell.Row, 5).Resize(, 144)
        If Not IsEmpty(CLL) Then [COLOR=#ff0000]dic.Add CLL.Value, ""[/COLOR]
    Next
    K = 1
    For i = 1 To UBound(Sarr)
        If Not dic.Exists(Sarr(i, 1)) Then
            RemainArr(K, 1) = Sarr(i, 1)
            K = K + 1
        End If
    Next
list = Join(Application.WorksheetFunction.Transpose(RemainArr), ",")
With ActiveCell.Validation
.Delete
.Add 3, , , list
.IgnoreBlank = True
End With
Set dic = Nothing
End Sub
Khi đặt protec sheet và nhấn vào ô có Validation thì nó lỗ ở dòng màu đỏ. Bản thử tìm cách xử lý xem nào.
 

File đính kèm

Lần chỉnh sửa cuối:
Nhiều chỗ mình chưa biết dùng vba như thế nào và nếu mình dùng thì không có vđ gì nhưng người khác dùng sợ sơ ý họ làm thay đổi các định dạng của bảng biếu không thống nhất.
Cách của bạn là như vậy là nó sẽ khóa tất các ô mà mình muốn chỉ khóa một số cột còn một số cột vẫn phải để nhập dl.

cái nào ko muốn nó khoá sau khi protect sheet, thì vào format cell chọn unclock
lúc protect cell, thì gở bỏ hết các dấu tick, chỉ để lại "select unclock cell"
 

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

Back
Top Bottom