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

Cô Bé Dễ Thương · 5/3/21

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)

ptm0412 · 7/3/21

emgaimuarao đã viết:
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 ạ.

- k và m là 2 biến ghi nhận dòng tăng dần để khỏi ghi đè (nói rồi)
- Nếu không gán trước 1 giá trị thì nó bằng 0, null, hoặc nothing tuỳ theo kiểu biến. Do nó sẽ tăng 1 và muốn dòng ghi đầu tiên là dòng 5 thì phải gán cho nó bằng 4 trước
- 7, 8, 9, 11, 12, 13 là lấy ngón tay đếm trên màn hình số thứ tự của 6 cột của 2 bảng kết quả

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
- k và m là 2 biến ghi nhận dòng tăng dần để khỏi ghi đè (nói rồi)
- Nếu không gán trước 1 giá trị thì nó bằng 0, null, hoặc nothing tuỳ theo kiểu biến. Do nó sẽ tăng 1 và muốn dòng ghi đầu tiên là dòng 5 thì phải gán cho nó bằng 4 trước
- 7, 8, 9, 11, 12, 13 là lấy ngón tay đếm trên màn hình số thứ tự của 6 cột của 2 bảng kết quả

- Vâng. Cái 7, 8, 9, 11, 12, 13 cháu cũng nghĩ là cột tính từ vị trí vùng data.
- giờ mới hiểu được giá trị k, m này ở các code trước của chú.
- Kết quả cháu muốn là chung 1 bảng. Cháu đổi 11,12,13 thành 7 8 9 thì nó lại mất đi 1 trường hợp. Cụ thể như ảnh ạ!

Sau khi đổi 11 12 13 thành 7 8 9 để chung 1 bảng thì

Chưa biết thêm cái If-End If gì nữa để nó chạy ra kết quả chung 1 bảng ạ. Hiện cháu đổi m = 4 thành m = 1 ; m = k + m + 1. Và 11 12 13 thành 7 8 9 thì được kết quả mong muốn. Nhưng không biết vậy có đúng hay sai trong thuật toán này của chú ạ!

ptm0412 · 7/3/21

Cùng 1 bảng kết quả thì chỉ cần 1 biến k thôi, chán!
_____
Chưa thả tim mấy bài rồi kìa! Thức đêm thức hôm, nắn nót từng câu từng chữ mà không chịu đọc cho hết, tim cũng không thả

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
Cùng 1 bảng kết quả thì chỉ cần 1 biến k thôi, chán!
_____
Chưa thả tim mấy bài rồi kìa! Thức đêm thức hôm, nắn nót từng câu từng chữ mà không chịu đọc cho hết, tim cũng không thả

đổi m = 1 ở chỗ khai báo, rồi trong ElseIf thì đặt m = m + 1 + k thảo nào nó lại nó lại đúng. Qua bài này không hành chú đêm hôm nữa. Xót chú quá.
Cháu sửa chung biến k rồi ạ. Xinh ơi là xinh, đẹp quá!

PHP:

Sub Filter_2Type()
Dim dict, ki, k, m
Set dict = CreateObject("Scripting.Dictionary")
'Bỏ m = 4, chỉ để k = 4
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
    ElseIf (a <> b And b = c) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
        'Thêm k vào chỗ này nữa là ok
            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

Cái que "|" này không biết gõ làm sao để có chú nhỉ? (Thôi cháu trốn thôi hic hic)

Hoàng Tuấn 868 · 7/3/21

emgaimuarao đã viết:
Cái que "|" này không biết gõ làm sao để có

Bạn thử ấn phím "Shift" và phím "\" xem thế nào.

Cô Bé Dễ Thương · 7/3/21

Hoàng Tuấn 868 đã viết:
Bạn thử ấn phím "Shift" và phím "\" xem thế nào.

Thanh bác. Trước giờ toàn copy xuống để dùng hihi

ptm0412 · 7/3/21

emgaimuarao đã viết:
Cháu sửa chung biến k rồi ạ. Xinh ơi là xinh, đẹp quá!

chung biến k, chung bảng kết quả, vậy thì if 1 lần thôi, khỏi else
if 3 màu or 2 màu then

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
chung biến k, chung bảng kết quả, vậy thì if 1 lần thôi, khỏi else
if 3 màu or 2 màu then

Đánh số thứ tự dựa vào m = dict.Count. Có ổn không ạ

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
chung biến k, chung bảng kết quả, vậy thì if 1 lần thôi, khỏi else
if 3 màu or 2 màu then

Ngon rồi ạ! Túc tắc vỡ vạc được nhiều thứ quá.

PHP:

Sub Filter_2Type_FIX()
Dim dict, ki, k, m
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) Or (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, 8).Interior.Color = a
            Cells(k, 9).Interior.Color = b
            Cells(k, 10).Interior.Color = c
        End If
   End If
Next rg
m = dict.Count
For i = 1 To m
Range("G" & i + 4).Value = i
Next i
End Sub

ptm0412 · 7/3/21

emgaimuarao đã viết:
Đánh số thứ tự dựa vào m = dict.Count. Có ổn không ạ

Nhìn thấy đúng, là đúng
nhưng đang có k = 5, 6, 7, 8, ... Sao không lấy k-4 bỏ vào cells(k, 6) luôn?

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
Nhìn thấy đúng, là đúng
nhưng đang có k = 5, 6, 7, 8, ... Sao không lấy k-4 bỏ vào cells(k, 6) luôn?

Có luôn ạ. Hay đến mức chưa hiểu ra vấn đề sao không dùng vòng lặp mà ra được ô Cell(k,7) = k-4 nó chạy như vòng lặp được ạ!
Chỉ hiểu được do biến rg nó chạy nó gán k tuần tự phải không ạ?
Nghỉ trưa ăn cơm chú nhỉ? Được đến đây là làm bài của mình phà phà rồi. Nhàn quá thu gọn cả 100 Sub thành 10 Sub, làm file excel nhẹ 9/10 rồi. Đến đây sảng khoái thật sự chú ạ! Cảm ơn chú rất nhiều! Ông bụt diễn đàn.

PHP:

Sub Filter_2Type_FIX()
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) Or (a <> b And b = c)) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            'Sửa bài #49
            Cells(k, 7).Value = k - 4
            Cells(k, 8).Interior.Color = a
            Cells(k, 9).Interior.Color = b
            Cells(k, 10).Interior.Color = c
        End If
   End If
Next rg
End Sub

Cô Bé Dễ Thương · 7/3/21

Thêm cột cộng dồn số lượng nếu trùng, có cho chung vào Sub này được không ạ? Hay phải tác ra viết riêng 1 Sub khác vậy chú Mỹ?
Cháu thứ mấy cú pháp học mót nhưng chưa ra được kết quả ạ!

PHP:

Sub Filter_2Type_FIX()
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) Or (a <> b And b = c)) Then
        ki = a & "|" & b & "|" & c
        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            'Sửa bài #49
            Cells(k, 7).Value = k - 4
            Cells(k, 8).Interior.Color = a
            Cells(k, 9).Interior.Color = b
            Cells(k, 10).Interior.Color = c
           'Thêm cột cộng dồn số lượng nếu trùng, có cho chung vào Sub này được không ạ? Hay phải tác ra viết riêng 1 Sub khác vậy chú Mỹ?
           'Thứ mấy cú pháp học mót nhưng chưa ra được kết quả ạ!
            Cells(k, 11).Value = dict.Item(ki)
        End If
   End If
Next rg
End Sub

ptm0412 · 7/3/21

emgaimuarao đã viết:
Cháu thứ mấy cú pháp học mót nhưng chưa ra được kết quả ạ!

Chủ nhật không hẹn hò, không cho con đi chơi hay sao mà ngồi đó vậy?
Cộng dồn là số cũ cộng thêm 1 giá trị nào đó thành số mới, chứ không cộng lấy gì mà dồn?
1. Cú pháp cộng dồn cho trường hợp dùng Dict và cộng dồn bằng item của Dict là:

PHP:

If thoả điều kiện Then
    sKey = "..."
    If chưa có trong Dict
        Dict.Add sKey, 1 'hoặc số ban đầu'
        '...'
    Else
        Dict.(sKey) = Dict.sKey + 1 'hoặc số tăng theo mong muốn'
    End If
Else 'không thoả'
    '...'
End If

Sau đó lấy xuống sheet bằng cách transpose Dict.Items

Nếu cộng dồn bằng 1 cột trong ResultArr thì phải có câu
ResultArr(m, n) = ResultArr(m, n) + ...
2. Trong bài này có thể ghi đè lên ô cũ:

PHP:

        If Not dict.exists(ki) Then
            k = k + 1
            dict.Add ki, k
            Cells(k, 7).Value = k - 4
            Cells(k, 8).Interior.Color = a
            Cells(k, 9).Interior.Color = b
            Cells(k, 10).Interior.Color = c
            Cells(k, 11) = 1
        Else
            Cells(Dict(ki),11) = Cells(Dict(ki),11) + 1
        End If

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
Chủ nhật không hẹn hò, không cho con đi chơi hay sao mà ngồi đó vậy?
Cộng dồn là số cũ cộng thêm 1 giá trị nào đó thành số mới, chứ không cộng lấy gì mà dồn?
1. Cú pháp cộng dồn cho trường hợp dùng Dict và cộng dồn bằng item của Dict là:

PHP:

If thoả điều kiện Then sKey = "..." If chưa có trong Dict Dict.Add sKey, 1 'hoặc số ban đầu' '...' Else Dict.(sKey) = Dict.sKey + 1 'hoặc số tăng theo mong muốn' End If Else 'không thoả' '...' End If

Sau đó lấy xuống sheet bằng cách transpose Dict.Items

Nếu cộng dồn bằng 1 cột trong ResultArr thì phải có câu
ResultArr(m, n) = ResultArr(m, n) + ...
2. Trong bài này có thể ghi đè lên ô cũ:

PHP:

If Not dict.exists(ki) Then k = k + 1 dict.Add ki, k Cells(k, 7).Value = k - 4 Cells(k, 8).Interior.Color = a Cells(k, 9).Interior.Color = b Cells(k, 10).Interior.Color = c Cells(k, 11) = 1 Else Cells(Dict(ki),11) = Cells(Dict(ki),11) + 1 End If

Nhân ngày 8/3 chúc mừng cô ạ
Được cách làm và cú pháp thế này, chắc cháu mò được rồi ạ.
Giờ chỉ mong có nhiều thời gian ngồi mò mẫm thôi chú ạ.

ptm0412 · 7/3/21

emgaimuarao đã viết:
Nhân ngày 8/3 chúc mừng cô ạ

Cô nào mà cô hả trời?

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
Cô nào mà cô hả trời?

Cô là bà ngoại của cháu ngoại chú ý. Chết dở hihi
Chú có tặng bông cô chưa?
Chập tối cơm xong sửa lại hết bộ file excel của cháu theo code mới chạy tít thật. Giờ cháu nghiện món VBA này rồi, thèm cái cảm giác chỉ bàn về tốc độ code, chắc sướng phải biết.
Chú uống thuốc đi nghỉ sớm đi chú ạ. Tối nào trc khi ngủ cháu cũng làm cốc nghệ. Thế mới có sức hành chú.

ptm0412 · 7/3/21

emgaimuarao đã viết:
Cô là bà ngoại của cháu ngoại chú ý. Chết dở hihi
Chú có tặng bông cô chưa ạ?

Chú đi ún rụ với bạn bè còn phải xin tiền bà í, có đâu tiền trong túi mà tặng bông.
Tặng bông 1 phát là lãnh đủ ngay:
- Có quỹ đen hả?
- Ngày 8/3 là cái quái gì? Một năm đủ 365 ngày cho tôi!
Dám trả lời là đi đếm rễ giá hoặc chia lá hành làm 20 khúc đều nhau ngay

Cô Bé Dễ Thương · 7/3/21

ptm0412 đã viết:
Chú đi ún rụ với bạn bè còn phải xin tiền bà í, có đâu tiền trong túi mà tặng bông.
Tặng bông 1 phát là lãnh đủ ngay:
- Có quỹ đen hả?
- Ngày 8/3 là cái quái gì? Một năm đủ 365 ngày cho tôi!
Dám trả lời là đi đếm rễ giá hoặc chia lá hành làm 20 khúc đều nhau ngay

Khéo cô đang ở sau lưng thì...
Mà cô để chú thức muộn vậy. Đi nghỉ sớm đi chú ơi.

Bài đã được tự động gộp: 7/3/21

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

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

File đính kèm

Bad Excel Member

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

Bad Excel Member

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

File đính kèm

Đăng ký hôm qua

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

Bad Excel Member

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

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

Bad Excel Member

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

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

Bad Excel Member

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

Bad Excel Member

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

Bad Excel Member

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