Cần giúp cách làm khác để bỏ cột phụ của cách làm hiện tại trong bài tập vba

Liên hệ QC
Cô Bé Dễ Thương

Cô Bé Dễ Thương

Thành viên thường trực
Tham gia
30/9/16
Bài viết
223
Được thích
48
Giới tính
Nữ
phu.jpg
Cháu chào cô bác và các anh chị.
Được chú Mỹ (ptm0412) cho code và cháu sửa lại theo ý của mình.
Do lúc trước xin code chỉ có 1 trường hợp nên nảy sinh thêm nhiều cột phụ.
- Cách giải của em (có trong file đính kèm):Bằng cách thêm cột phụ và mỗi cột phụ tương đương một Sub, cuối cùng tạo ra một Sub nữa dùng để gộp các cột phụ lại để gán vào cột Dạng ở bảng 1 (nút Run và Xóa đã thể hiện cách giải)<--- nhưng thô quá, số lượng Dạng lớn đến hàng trăm thì...tay to mất!
- Mong muốn: Vẫn dùng Dict vba(hoặc cách khác) mà không dùng đến các cột phụ.
Do trình độ không thể khắc phục được, cháu đăng lên nhờ các bác và các bạn giúp đỡ cho ạ!
(cụ thể file đính kèm)
 

File đính kèm

  • dienten.xlsm
    25 KB · Đọc: 10
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Chỗ màu đỏ trong bài #16 sửa thành SData là xong. Tôi đã chỉ chỗ sai rồi, chỉ cần so sánh với các code khác là biết sửa như thế nào thôi.
 
Upvote 0
huuthang_bd đã viết:
Bài #16 chỉ đánh dấu chỗ sai chứ chưa sửa.
Nhấp chuột vào đây để mở rộng...
Tôi viết là "chỉnh sửa từ bạn @huuthang_bd" nghĩa là chỉnh sửa từ "gợi ý" của bạn @huuthang_bd
Bạn đánh dấu chỗ sai, nhưng toàn bộ code là tự viết/ và chỉnh sửa từ code gợi ý/ hướng dẫn của bạn trong bài 14. Trong đó có nhiều chỗ sai ngoại trừ chỗ đỏ bạn đánh dấu:
- Code bạn gợi ý cho bài #1 nhưng xài cho file bài 17, mà bài 17 chèn thêm cột kết quả G nên bị lệch cột.
- Lệch luôn cả chỗ SampleArr = Range("o5:r8"), gốc gợi ý là Range("Q5:Q8"). Sau khi chèn cột đáng lẽ là R5:R8
 
Upvote 0
@emgaimuarao Tôi thêm nhiều cột cần lấy để bạn thấy sự khác biệt. Muốn vận dụng được thì bạn phải nghiên cứu để hiểu code chứ sửa theo kiểu hên xui may rủi thì nguy hiểm quá.
PHP: 
Sub CheckNote_All_BAC_huuthang_bd()
Dim Dict, SData As Range, RArr(), Sample As Range, SampleArr As Variant
Dim i As Long, j As Long, k As Long
Dim LastRw As Long, sKey As String, DataRows As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("O5:Q8")
SampleArr = Range("R5:W8").Value 'Muon them/bot cot chi can sua cho nay
For i = 1 To Sample.Rows.Count
    sKey = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey, i
Next
LastRw = Cells(1000, 2).End(xlUp).Row
Set SData = Range("C5:E" & LastRw)
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To UBound(SampleArr, 2))
For i = 1 To DataRows
    sKey = SData(i, 1).Interior.Color & _
    "|" & SData(i, 2).Interior.Color & _
    "|" & SData(i, 3).Interior.Color
    If Dict.exists(sKey) Then
        k = Dict.Item(sKey)
        For j = 1 To UBound(SampleArr, 2)
            RArr(i, j) = SampleArr(k, j)
            RArr(i, j) = SampleArr(k, j)
        Next
    End If
Next
Range("F5").Resize(UBound(RArr, 1), UBound(SampleArr, 2)).Value = RArr
End Sub
 

File đính kèm

  • dienten.xlsm
    25 KB · Đọc: 4
Upvote 0
huuthang_bd đã viết:
@emgaimuarao Tôi thêm nhiều cột cần lấy để bạn thấy sự khác biệt. Muốn vận dụng được thì bạn phải nghiên cứu để hiểu code chứ sửa theo kiểu hên xui may rủi thì nguy hiểm quá.
PHP: 
Sub CheckNote_All_BAC_huuthang_bd()
Dim Dict, SData As Range, RArr(), Sample As Range, SampleArr As Variant
Dim i As Long, j As Long, k As Long
Dim LastRw As Long, sKey As String, DataRows As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("O5:Q8")
SampleArr = Range("R5:W8").Value 'Muon them/bot cot chi can sua cho nay
For i = 1 To Sample.Rows.Count
    sKey = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey, i
Next
LastRw = Cells(1000, 2).End(xlUp).Row
Set SData = Range("C5:E" & LastRw)
DataRows = SData.Rows.Count
ReDim RArr(1 To DataRows, 1 To UBound(SampleArr, 2))
For i = 1 To DataRows
    sKey = SData(i, 1).Interior.Color & _
    "|" & SData(i, 2).Interior.Color & _
    "|" & SData(i, 3).Interior.Color
    If Dict.exists(sKey) Then
        k = Dict.Item(sKey)
        For j = 1 To UBound(SampleArr, 2)
            RArr(i, j) = SampleArr(k, j)
            RArr(i, j) = SampleArr(k, j)
        Next
    End If
Next
Range("F5").Resize(UBound(RArr, 1), UBound(SampleArr, 2)).Value = RArr
End Sub
Nhấp chuột vào đây để mở rộng...
Cháu cảm ơn ạ, cháu vẫn đang học nhưng không được nhanh. Thiếu cú pháp và lý luận về mảng nên hiện nay làm gì vẫn mò mò thấy giống rồi thử áp dụng.
 
Upvote 0
huuthang_bd đã viết:
@emgaimuarao Tôi thêm nhiều cột cần lấy để bạn thấy sự khác biệt. Muốn vận dụng được thì bạn phải nghiên cứu để hiểu code chứ sửa theo kiểu hên xui may rủi thì nguy hiểm quá.
Nhấp chuột vào đây để mở rộng...
Code dư 1 câu lệnh (2 câu giống hệt nhau)
1614955198671.png
Tuy nhiên điều đó không quan trọng.
Còn nữa, đối với trình độ bạn này thì tôi thường viết code đơn giản hết mức có thể.
- Code gợi ý bài 14 Redim (..., 0 to UBound(SampleArr, 1)) là quá sức với bạn ấy, tôi sẽ viết 1 to UBound(SampleArr, 1) +1, hoặc dùng 1 biến lấy giá trị "số dòng của sample Arr" với tên gợi hình gợi thanh gợi ý. Vậy mà chưa chắc thủng nữa là
- Code gợi ý bài 23 nếu là tôi thì cũng dùng 1 biến "số cột của SampleArr"
Đối với đầu vịt thì không đổ nước thông thường mà phải đổ nước ... sôi, quên, nước hoa :D :D
 
Upvote 0
ptm0412 đã viết:
Code dư 1 câu lệnh (2 câu giống hệt nhau)
View attachment 254942
Tuy nhiên điều đó không quan trọng.
Còn nữa, đối với trình độ bạn này thì tôi thường viết code đơn giản hết mức có thể.
- Code gợi ý bài 14 Redim (..., 0 to UBound(SampleArr, 1)) là quá sức với bạn ấy, tôi sẽ viết 1 to UBound(SampleArr, 1) +1, hoặc dùng 1 biến lấy giá trị "số dòng của sample Arr" với tên gợi hình gợi thanh gợi ý. Vậy mà chưa chắc thủng nữa là
- Code gợi ý bài 23 nếu là tôi thì cũng dùng 1 biến "số cột của SampleArr"
Đối với đầu vịt thì không đổ nước thông thường mà phải đổ nước ... sôi, quên, nước hoa :D :D
Nhấp chuột vào đây để mở rộng...
- Bài giải có nhiều cách mới thấm chú Mỹ ạ. Nhiều cách giải của 1 bài thì lại được học thêm cú pháp và lý luận. Dòng lệnh nào nhiều kiến thức mà được thêm comment nữa thì quá tuyệt vời ạ.
- Bài #17 là cháu có nghĩ tới code của bác @VetMini bên thớt khác, chứ không phải đoán mà đâu ạ.
- Trước bài #23 cháu nãy thử lại và kiểm tra không chạy được, giờ so sánh thấy trình chưa đủ để bù những chỗ thiếu.
 
Lần chỉnh sửa cuối:
Upvote 0
ptm0412 đã viết:
Còn nữa, đối với trình độ bạn này thì tôi thường viết code đơn giản hết mức có thể.
Nhấp chuột vào đây để mở rộng...
Em thì nghĩ thói quen và phong cách viết code sẽ dần hình thành ngay từ lúc bắt đầu tập viết code. Vì vậy cứ chia sẻ những gì mình cho là tốt.
 
Upvote 0
chontheodk.jpg
Cháu có dạng chưa biết cú pháp để đưa giá trị là Key trong Dic ra ngoài bảng tính.
Xin chú Mỹ, cô bác giúp và anh chị giúp cháu phần cú pháp và lý luận này với ạ!
(Cụ thể file đính kèm và phần Code cháu đang làm dở ạ)
PHP: 
Sub chontheodieukien()
Dim Dict, SData As Range, RArr(), Sample As Range
Dim LastRw As Long, sKey_1 As String, sKey_2 As String, DataRows As Long
LastRw = Application.WorksheetFunction.CountA(Sheets("Sheet1").Range("B:B")) - 3
Set Dict = CreateObject("Scripting.Dictionary")
Set Sample = Range("C5:E" & LastRw + 4)
For i = 1 To Sample.Rows.Count
    a = Sample(i, 1).Interior.Color
    b = Sample(i, 2).Interior.Color
    c = Sample(i, 3).Interior.Color

    If (a = b And b = c) Then
    sKey_1 = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey_1, i
    End If

    If (a <> b And b = c) Then
    sKey_2 = Sample(i, 1).Interior.Color & _
    "|" & Sample(i, 2).Interior.Color & _
    "|" & Sample(i, 3).Interior.Color
    Dict.Add sKey_2, i
    End If
Next i
'......................
Với mỗi 1 If-End If ở trên cháu đã Add được sKey_1 và sKey_2 vào Dict
Xin cho cháu xin phần code  để đưa giá trị toàn bộ Key có trong Dict
Ra vị trí bắt đầu tờ H5
'......................
End Sub
 

File đính kèm

  • chontheodk.xlsm
    19.3 KB · Đọc: 3
Lần chỉnh sửa cuối:
Upvote 0
- Tìm LastRw sao không tìm bằng End(xlUp)?
- Có lastRw sao không gán vào Range dữ liệu?
- Sao Range dữ liệu đặt tên là Sample (mẫu)?
- Sao lại gán j +4? j không khai báo và có biết j bằng bao nhiêu không?
- Dict.Add sKey_2: Có thử dò sKey_2 bằng cái gì chưa?
- cả 2 trường hợp add chung vào 1 Dict rồi làm sao tách ra?
 
Upvote 0
ptm0412 đã viết:
- Tìm LastRw sao không tìm bằng End(xlUp)?
- Có lastRw sao không gán vào Range dữ liệu?
- Sao Range dữ liệu đặt tên là Sample (mẫu)?
- Sao lại gán j +4? j không khai báo và có biết j bằng bao nhiêu không?
- Dict.Add sKey_2: Có thử dò sKey_2 bằng cái gì chưa?
- cả 2 trường hợp add chung vào 1 Dict rồi làm sao tách ra?
Nhấp chuột vào đây để mở rộng...
- Tìm LastRw sao không tìm bằng End(xlUp)? TL: Cháu khống chế định dạng tiêu đề chung các Sheets lên kiểm soát được ạ.
- Có lastRw sao không gán vào Range dữ liệu? TL: Do sơ xuất nên chưa sửa hết ạ
- Sao Range dữ liệu đặt tên là Sample (mẫu)? TL: Vì lúc này bài toán chỉ trơ trọi 1 Bảng dữ liệu ạ
- Sao lại gán j +4? j không khai báo và có biết j bằng bao nhiêu không? TL: cháu quên chưa thay LastRw = j, copy lại code trước đang làm lên quên chỗ đó ạ
- Dict.Add sKey_2: Có thử dò sKey_2 bằng cái gì chưa? TL: Ngược lại thì sử dụng các code trước của Chú là tách được ạ. Các bài trước đây là dùng Key để tra ra Item, giờ là trường hợp khác. Lợi dụng Key là duy nhất để lọc ạ
Cháu vừa mò được đoạn:
PHP: 
'........
s = Dict.Count
Sheet1.[h5].Resize(s, 3) = Application.Transpose(Dict.keys)
'.....
chua dung.jpg

Mà chạy chưa đúng ạ.
Giờ Add sKye_1, Add Kye_2 vào Dict rồi. Làm sao để dán các Key này xuống Dict. Giúp cháu với!
 
Lần chỉnh sửa cuối:
Upvote 0
- Đọc kỹ code lại đi: câu lệnh nào gán j = CountA?
- Trơ trọi 1 bảng dữ liệu thí chính nó là dữ liệu, là Data chứ mẫu gì (sample = mẫu)
- Đọc kỹ câu lệnh nào tính sKey_2? Chả có câu nào, sKey_2 = null
- sKey_1 cũng add và item là i, sKey_2 cũng item là i, có mà giời tách
 
Upvote 0
ptm0412 đã viết:
- Đọc kỹ code lại đi: câu lệnh nào gán j = CountA?
- Trơ trọi 1 bảng dữ liệu thí chính nó là dữ liệu, là Data chứ mẫu gì (sample = mẫu)
- Đọc kỹ câu lệnh nào tính sKey_2? Chả có câu nào, sKey_2 = null
- sKey_1 cũng add và item là i, sKey_2 cũng item là i, có mà giời tách
Nhấp chuột vào đây để mở rộng...
- Cháu nghĩ: Vùng cháu chọn cháu biết chắc là có sKye_1, sKey_2 tồn tại. Khi cháu đưa If-End If vào thì nó sẽ lọc theo điều kiên a,b,c để có tập Key. Khi có tập Key cháu dán xuống Sheet
- tạo 1 Key và tìm Item của nó các bài trước cũng hòm hòm rồi ạ
- Giờ tạo hai Key và lấy tập Key thì chưa biết ạ? Không biết bài #30 có làm như cháu nghĩ được không chú? Hay buộc phải có biện pháp khác ạ?
Untitled.jpg
 

File đính kèm

  • chontheodk.xlsm
    19.3 KB · Đọc: 1
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
- Cháu nghĩ: Vùng cháu chọn cháu biết chắc là có sKye_1, sKey_2 tồn tại. Khi cháu đưa If-End If vào thì nó sẽ lọc theo điều kiên a,b,c để có tập Key. Khi có tập Key cháu dán xuống Sheet
- tạo 1 Key và tìm Item của nó các bài trước cũng hòm hòm rồi ạ
- Giờ tạo hai Key và lấy tập Key thì chưa biết ạ? Không biết bài #30 có làm như cháu nghĩ được không chú? Hay buộc phải có biện pháp khác ạ?
Nhấp chuột vào đây để mở rộng...
Chán quá đi à.
- Câu lệnh là LastRw = ... CountA chứ có phải j = CountA đâu?
- Câu lệnh là
sKey_1 = ...
Dict.Add sKey_2, i
chứ có phải sKey_2 đâu mà gán sKey_2?
- item của cả 2 loại màu là i, là STT dòng của range dữ liệu có xài được cho Bảng 2 đâu? chả lẽ bảng 2 rời rạc?
- đã tính a, b, c rồi mà 2 cái sKey lại phải tính lại lần nữa?

Tất cả các câu hỏi trên nhằm mục đích mắng cho cái chuyện copy code của người khác từng câu từng câu về mà không biết nó ra kết quả gì, thậm chí copy dòng trên xuống dòng dưới mà sửa không rốt ráo.
Phướng pháp là các bước thế này:
1. Tự suy nghĩ về thuật toán (cái gọi là ní nuận ấy)
2. Ghi ra giấy, nghĩ lại lần nữa, sắp xếp lại nếu cần
3. Tự viết câu lệnh dựa vào ní nuận đã ghi trên giấy, không copy từng dòng lệnh của người khác, trừ khi biết chính xác là câu lệnh copy đó phù hợp với ní nuận
4. Viết xong chạy thử từng dòng lệnh: Nhấn F8 để chạy từng câu lệnh.
- Sau mỗi câu lệnh, rà chuột vào các biến để xem giá trị tức thời của biến (chỉ xem được biến đơn, không xem được biến mảng hoặc giá trị mảng, giá trị range nhiều ô).
- Đối chiếu với giá trị mong muốn
- Nếu code có cấu trúc If, thì xem lệnh chạy đến điều kiện của If rồi chạy thẳng đến else, hay chạy các dòng lệnh của if? Việc này đúng hay sai so với mong muốn?
- Nếu có vòng lặp, thì xét ít nhất 3 vòng lặp xem các câu lệnh có chạy đúng ý muốn chưa

Đối với bài này:
- xác định ý muốn là gì: Liệt kê riêng 3 màu giống nhau và 2 màu cuối giống nhau, hay liệt kê riêng 2 bảng. Liệt kê chung thì mới bỏ chung vào 1 Dict
- Xác định là mỗi bộ màu thoả điều kiện chỉ liệt kê 1 lần, hay liệt kê hết? (thí dụ có 3 dòng đều có 3 ô màu đỏ thì liệt kê 1 lần hay 3 lần). Nếu chỉ liệt kê 1 lần mới xài Dict
- đặt 3 biến a, b, c để lấy 3 già trị màu, ok. Vậy thì các sKey nối a, b, c chứ mắc gì nối lại 3 lần tìm giá trị màu? Cái này rõ ràng là làm biếng viết, nghĩ rồi mà không viết, lại đi copy. Rồi rõ ràng mu61n add sKey_2, mà lại copy câu lệnh của sKey_1 xuống, không sửa 1 thành 2!
- Vòng lặp i chạy qua vùng dữ liệu, vậy i có xài được cho bảng kết quả không? Nếu không thì gán item là i làm cái quái gì.
- Kết quả là cần màu, chứ có cần key hay item đâu mà transpose? Phải dùng kết quả a, b, c là giá trị màu, gán màu vào bảng 2.
- Nếu gán màu xuống bảng 2 thì phải có biến dòng cho bảng 2, mỗi lần ghi màu là tăng lên 1, chứ không là ghi đè vào dòng cũ.

Mắng cũng bắt mệt rồi đa!
 
Upvote 0
ptm0412 đã viết:
Chán quá đi à.
- Câu lệnh là LastRw = ... CountA chứ có phải j = CountA đâu?
- Câu lệnh là
sKey_1 = ...
Dict.Add sKey_2, i
chứ có phải sKey_2 đâu mà gán sKey_2?
- item của cả 2 loại màu là i, là STT dòng của range dữ liệu có xài được cho Bảng 2 đâu? chả lẽ bảng 2 rời rạc?
- đã tính a, b, c rồi mà 2 cái sKey lại phải tính lại lần nữa?

Tất cả các câu hỏi trên nhằm mục đích mắng cho cái chuyện copy code của người khác từng câu từng câu về mà không biết nó ra kết quả gì, thậm chí copy dòng trên xuống dòng dưới mà sửa không rốt ráo.
Phướng pháp là các bước thế này:
1. Tự suy nghĩ về thuật toán (cái gọi là ní nuận ấy)
2. Ghi ra giấy, nghĩ lại lần nữa, sắp xếp lại nếu cần
3. Tự viết câu lệnh dựa vào ní nuận đã ghi trên giấy, không copy từng dòng lệnh của người khác, trừ khi biết chính xác là câu lệnh copy đó phù hợp với ní nuận
4. Viết xong chạy thử từng dòng lệnh: Nhấn F8 để chạy từng câu lệnh.
- Sau mỗi câu lệnh, rà chuột vào các biến để xem giá trị tức thời của biến (chỉ xem được biến đơn, không xem được biến mảng hoặc giá trị mảng, giá trị range nhiều ô).
- Đối chiếu với giá trị mong muốn
- Nếu code có cấu trúc If, thì xem lệnh chạy đến điều kiện của If rồi chạy thẳng đến else, hay chạy các dòng lệnh của if? Việc này đúng hay sai so với mong muốn?
- Nếu có vòng lặp, thì xét ít nhất 3 vòng lặp xem các câu lệnh có chạy đúng ý muốn chưa

Đối với bài này:
- xác định ý muốn là gì: Liệt kê riêng 3 màu giống nhau và 2 màu cuối giống nhau, hay liệt kê riêng 2 bảng. Liệt kê chung thì mới bỏ chung vào 1 Dict
- Xác định là mỗi bộ màu thoả điều kiện chỉ liệt kê 1 lần, hay liệt kê hết? (thí dụ có 3 dòng đều có 3 ô màu đỏ thì liệt kê 1 lần hay 3 lần). Nếu chỉ liệt kê 1 lần mới xài Dict
- đặt 3 biến a, b, c để lấy 3 già trị màu, ok. Vậy thì các sKey nối a, b, c chứ mắc gì nối lại 3 lần tìm giá trị màu? Cái này rõ ràng là làm biếng viết, nghĩ rồi mà không viết, lại đi copy. Rồi rõ ràng mu61n add sKey_2, mà lại copy câu lệnh của sKey_1 xuống, không sửa 1 thành 2!
- Vòng lặp i chạy qua vùng dữ liệu, vậy i có xài được cho bảng kết quả không? Nếu không thì gán item là i làm cái quái gì.
- Kết quả là cần màu, chứ có cần key hay item đâu mà transpose? Phải dùng kết quả a, b, c là giá trị màu, gán màu vào bảng 2.
- Nếu gán màu xuống bảng 2 thì phải có biến dòng cho bảng 2, mỗi lần ghi màu là tăng lên 1, chứ không là ghi đè vào dòng cũ.

Mắng cũng bắt mệt rồi đa!
Nhấp chuột vào đây để mở rộng...
- Vâng cháu sơ suất mất tập chung chỗ đấy thành ra hành chú mất rồi. Hic hic xót chú.
- Bài #30 cháu muốn liệt kê 2 trường hợp chung 1 bảng và 1 lần. Thí dụ có 3 dòng đều có 3 ô màu đỏ thì chỉ liệt kê 1 lần.(1 trường hợp cháu làm ngon)
Không biết bài #30 tạo ra nhiều Key cùng 1 Sub rồi lấy tất cả các Key ra đươc không chú nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
- Vâng cháu sơ suất mất tập chung chỗ đấy thành ra hành chú mất rồi. Hic hic xót chú.
- Bài #30 cháu muốn liệt kê 1 lần. Thí dụ có 3 dòng đều có 3 ô màu đỏ thì chỉ liệt kê 1 lần.
Không biết bài #30 tạo ra nhiều Key cùng 1 Sub rồi lấy tất cả các Key ra đươc không chú nhỉ?
Nhấp chuột vào đây để mở rộng...
Đã nói là không cần lấy key, lấy a, b, c gắn màu cho 1 dòng của bảng 2. Nhớ thêm 1 biến dòng tăng cho bảng 2.
Key là chuỗi dài ngoằng đó xài gì được cho việc gan màu.
 
Upvote 0
ptm0412 đã viết:
Đã nói là không cần lấy key, lấy a, b, c gắn màu cho 1 dòng của bảng 2. Nhớ thêm 1 biến dòng tăng cho bảng 2.
Key là chuỗi dài ngoằng đó xài gì được cho việc gan màu.
Nhấp chuột vào đây để mở rộng...
Vâng ạ. Để mai cháu làm lại 2 gạch đầu dòng dưới đây.
- Giải kiểu range("H5") = a, lúc đó cháu đoán mò là nó sẽ liệt kê tất cả, mà trong khi đó cháu cần điểm danh 1 lần. Chung vào một bảng.
- Mà dùng dictionary với 1 key cháu làm được từng trường hợp ngon. Nhưng trên sheet lại thêm cột kết quả.
 
Upvote 0
ptm0412 đã viết:
Cần gán màu hay cần gán giá trị màu mà "giải kiểu" này?
Nhấp chuột vào đây để mở rộng...
- Gán màu ạ. Cụ thể khi gán là Range("H5").Interior.Color = RGB(r,g,b) ạ. Lúc đó tô màu đc 1 ô H5. Cứ If-End If là tô theo ý mình đc ạ.
- Và rắc rồi bắt đàu từ ý muốn 2 Sub thành 1 Sub và 2 bảng kết quả chung 1 bảng. Lúc đó lại khóc rồi hic
Thấy chú còn xanh xanh, cháu thử làm theo cách Dict chú coi qua cháu với nhé. Có giải theo Dictionary. file đính kèm rồi ạ
2 bảng.jpg
Bài #30 hiện cháu giải theo cách này mà vẫn dùng Dict. Nhưng nó nảy sinh vẫn đề là phát sinh nhiều Sub và nhiều bảng kết quả nếu có nhiều trường hợp.
Vì đang học Dictionary nên cháu muốn giải theo hướng này.
Mong muốn: Gộp tất cả các trường hợp vào chúng 1 Sub và kết xuất ra chung 1 bảng
 

File đính kèm

  • chontheodk.xlsm
    44.9 KB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
emgaimuarao đã viết:
Thấy chú còn xanh xanh,
Nhấp chuột vào đây để mở rộng...
Xanh thì xanh chứ, đến giờ ăn khuya để uống thuốc ai mà ngồi mãi.
Do cần liệt kê chỉ 1 lần cho mỗi bộ nên vẫn dùng Dict.
Đã nói rồi, không cần xài chuỗi key dài ngoằng mà cứ xài, đã bảo xài a, b, c đi mà không xài (2 chỗ)
PHP: 
Sub Filter_1()
Dim dict, ki, k
Set dict = CreateObject("Scripting.Dictionary")
k = 4
For Each rg In Range("C5:E19").Rows
    a = rg.Cells(1, 1).Interior.Color
    b = rg.Cells(1, 2).Interior.Color
    c = rg.Cells(1, 3).Interior.Color
    If (a = b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Interior.Color = a
            Cells(k, 8).Interior.Color = b
            Cells(k, 9).Interior.Color = c
        End If
    End If
Next rg
End Sub
Code gộp ra 2 bảng:
PHP: 
Sub Filter_2Type()
Dim dict, ki, k, m
Set dict = CreateObject("Scripting.Dictionary")
k = 4: m = 4
For Each rg In Range("C5:E19").Rows
    a = rg.Cells(1, 1).Interior.Color
    b = rg.Cells(1, 2).Interior.Color
    c = rg.Cells(1, 3).Interior.Color
    If (a = b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Interior.Color = a
            Cells(k, 8).Interior.Color = b
            Cells(k, 9).Interior.Color = c
        End If
    ElseIf (a <> b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            m = m + 1
            dict.Add ki, m
            Cells(m, 11).Interior.Color = a
            Cells(m, 12).Interior.Color = b
            Cells(m, 13).Interior.Color = c
        End If
    End If
Next rg
End Sub

Còn sub Delete đọc thấy gớm, giống record macro sao để vậy
Rich (BB code): 
Sub DELETE()
    Range("G5:M1000").ClearFormats
End Sub
 
Upvote 0
ptm0412 đã viết:
Xanh thì xanh chứ, đến giờ ăn khuya để uống thuốc ai mà ngồi mãi.
Do cần liệt kê chỉ 1 lần cho mỗi bộ nên vẫn dùng Dict.
Đã nói rồi, không cần xài chuỗi key dài ngoằng mà cứ xài, đã bảo xài a, b, c đi mà không xài (2 chỗ)
PHP: 
Sub Filter_1()
Dim dict, ki, k
Set dict = CreateObject("Scripting.Dictionary")
k = 4
For Each rg In Range("C5:E19").Rows
    a = rg.Cells(1, 1).Interior.Color
    b = rg.Cells(1, 2).Interior.Color
    c = rg.Cells(1, 3).Interior.Color
    If (a = b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Interior.Color = a
            Cells(k, 8).Interior.Color = b
            Cells(k, 9).Interior.Color = c
        End If
    End If
Next rg
End Sub
Code gộp ra 2 bảng:
PHP: 
Sub Filter_2Type()
Dim dict, ki, k, m
Set dict = CreateObject("Scripting.Dictionary")
k = 4: m = 4
For Each rg In Range("C5:E19").Rows
    a = rg.Cells(1, 1).Interior.Color
    b = rg.Cells(1, 2).Interior.Color
    c = rg.Cells(1, 3).Interior.Color
    If (a = b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Interior.Color = a
            Cells(k, 8).Interior.Color = b
            Cells(k, 9).Interior.Color = c
        End If
    ElseIf (a <> b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            m = m + 1
            dict.Add ki, m
            Cells(m, 11).Interior.Color = a
            Cells(m, 12).Interior.Color = b
            Cells(m, 13).Interior.Color = c
        End If
    End If
Next rg
End Sub

Còn sub Delete đọc thấy gớm, giống record macro sao để vậy
Rich (BB code): 
Sub DELETE()
    Range("G5:M1000").ClearFormats
End Sub
Nhấp chuột vào đây để mở rộng...
Chú thức muộn quá.
Do hay phải thức đêm nhiều nên cháu đang sợ vấn đề dạ dày về sau, mà hay lo nghĩ, hoặc lắm thứ phải nghĩ thì rất hại dạ dày. Cháu bị hay bị ợ hơi, dùng nano nghệ thấy đỡ.
Trong 2 code trên cháu chưa hiểu:
1, k = 4
2, k = 4: m = 4
3, Cell(k, 7 hoặc 8 hoặc 9) hay Cell(m, 11 hoặc 12 hoặc 13)
Làm sao xác đinh được các giá trị m, k và chỉ số cột có trong Cell ạ.
Code ở dưới tên Sub Filter_2Type() là gộp 2 trương hợp thành 1 Sub, nhưng kết quả vẫn cho ra 2 bảng. Cháu muốn chú giúp cho thành 1 bảng kết quả chung của 2 trường hơp ạ
PHP: 
Sub Filter_2Type()
Dim dict, ki, k, m
Set dict = CreateObject("Scripting.Dictionary")
k = 4: m = 4
For Each rg In Range("C5:E19").Rows
    a = rg.Cells(1, 1).Interior.Color
    b = rg.Cells(1, 2).Interior.Color
    c = rg.Cells(1, 3).Interior.Color
    If (a = b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Interior.Color = a
            Cells(k, 8).Interior.Color = b
            Cells(k, 9).Interior.Color = c
        End If
    ElseIf (a <> b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            m = m + 1
            dict.Add ki, m
            Cells(m, 11).Interior.Color = a
            Cells(m, 12).Interior.Color = b
            Cells(m, 13).Interior.Color = c
        End If
    End If
Next rg
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

dungluf123
Lỗi khi sử dụng công thức để link từ file này sang file khác của Excel trên hệ thống mạng chung của công ty
Trả lời
0
Đọc
18
dungluf123
dungluf123
V
Tìm điều kiện sau đó tính tổng ma hang theo điều kiện
Trả lời
5
Đọc
46
vnproc
V
hongphuong1997
  • Question
Lấy ký tự trong chuỗi theo nhiều điều kiện
Trả lời
0
Đọc
23
hongphuong1997
hongphuong1997
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
1
Đọc
24
DeTong
D
phanmoi688
[Xin nhờ giúp đỡ] Tìm cách xóa các ký tự trắng trong biểu
Trả lời
4
Đọc
44
phanmoi688
phanmoi688
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

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

Back
Top Bottom