Tìm chuổi màu giống nhau (1 người xem)

[dugia97]

Thanks bạn HYen17 cho mỉnh thêm tham khảo.

Mãi tơi giờ này mới làm xong chuổi màu mới để run lại code của hai bạn.(sheet2)

To Viehoai, bạn xem lại kết quả,(không biết minh chuyển đổi sang sheet2 làm sai code không?, nếu có thì xí xóa cho minh nhe, sorry)


To HYen17 : GPE... Thanks

 

[dugia97]

Cháo các bạn
Minh đang dạy con mình học nhận dịên chuổi số giống nhau, con mình ok thông thạo rồi. Nay nghỉ tới tim chuổi màu sắc giống nhau. các bạn xem book1.xlsm

chuổi màu muốn tìm: B6:H7
chuổi màu cố định : B2Y3
các bạn giúp minh viết đoạn code matching patterm B6:H7 trong B2Y3


Cám ơn cac bạn trước nhe.



dugia97

 

[viehoai]

Cháo các bạn
Minh đang dạy con mình học nhận dịên chuổi số giống nhau, con mình ok thông thạo rồi. Nay nghỉ tới tim chuổi màu sắc giống nhau. các bạn xem book1.xlsm

chuổi màu muốn tìm: B6:H7
chuổi màu cố định : B2Y3
các bạn giúp minh viết đoạn code matching patterm B6:H7 trong B2Y3
Cám ơn cac bạn trước nhe.
dugia97

Bạn xem file đúng ý bạn không nhé

 

[dugia97]

Wow, bạn viehoai, thật không ngờ bạn giai đáp nhanh và gọn qúa.

Mới làm về đã có tin vui từ bạn. Minh xin cảm ơn Viehoain và diễn đàn.

dugia

 

[SA_DQ]

Thêm 1 tham khảo cho bạn

Sub TimOTrungMau()
 Dim Rng As Range, sRng As Range, Cls As Range, fRng As Range
 Dim Rws As Long, Col As Byte, Num As Byte, jJ As Byte

 [B9].Value = "GPE"
 Set Rng = Sheet1.Range("B6:G7")
 Rws = Rng.Rows.Count:          Col = Rng.Columns.Count
 Num = Rng.Cells.Count
 
 Set sRng = Sheet1.Range("B2:DY2")
 For Each Cls In sRng
    Set fRng = Cls.Resize(Rws, Col)
    For jJ = 1 To Num
        If fRng(jJ).Interior.ColorIndex <> Rng(jJ).Interior.ColorIndex Then
            Exit For
        Else
            If jJ >= Num Then [B99].End(xlUp).Offset(1).Value = fRng.Address
        End If
    Next jJ
 Next Cls
End Sub

 

[dugia97]

Hi , chị Hyen17

Sub TimOTrungMau()
Dim Rng As Range, sRng As Range, Cls As Range, fRng As Range
Dim Rws As Long, Col As Byte, Num As Byte, jJ As Byte
[B9].Value = "GPE"
Set Rng = Sheet2.Range("B6:G7")
Rws = Rng.Rows.Count: Col = Rng.Columns.Count
Num = Rng.Cells.Count

Set sRng = Sheet2.Range("B2:LKL2")
For Each Cls In sRng
Set fRng = Cls.Resize(Rws, Col)
For jJ = 1 To Num
If fRng(jJ).Value <> Rng(jJ).Value Then
Exit For
Else
If jJ >= Num Then [B99].End(xlUp).Offset(1).Value = fRng.Address
End If
Next jJ
Next Cls
End sub

help 1
chi có thể giúp tôi thêm đoạn code highlight ở line3, dưới pattern đã tìm được
(sheet2. book1.xlsm) được không ?
Help 2
Làm sao thêm vào ".0" ở các cell thiếu ".5" (sheet1. book1.xlsm) được không ?
Xin Cám ơn trước .

 

[SA_DQ]

(1), (2)?!?

Option Explicit
[B]Sub TimOTrungMau()
[/B] Dim Rng As Range, sRng As Range, Cls As Range, fRng As Range
 Dim Rws As Long, Col As Byte, Num As Byte, jJ As Byte
 
 ActiveWorkbook.Sheets("sheet2").Select
 [B9].Value = "GPE"
 Set Rng = Sheet2.Range("B6:G7")
 Rws = Rng.Rows.Count:          Col = Rng.Columns.Count
 Num = Rng.Cells.Count
 
Chú_Ý: Set sRng = Sheet2.Range("B2:iQ2")  'LKL'
 For Each Cls In sRng
    Set fRng = Cls.Resize(Rws, Col)
    For jJ = 1 To Num
        If fRng(jJ).Value <> Rng(jJ).Value Then
            Exit For
        Else
            If jJ >= Num Then
                [B99].End(xlUp).Offset(1).Value = fRng.Address
GPE:                Randomize
YES:                fRng(1).Offset(2).Resize(, Col).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
            End If
        End If
    Next jJ
 Next Cls
[B]End Sub
[/B]

 

[dugia97]

Hi, chi Hyen17
mới thử run một vài pattern. Thành thật cảm ơn chị Hyen17 một lần nữa. Thật tuyệt khi random màu. Như thế tôi chỉ cần hide line3 cho cháu nó tập nhìn pattern.
help 2
col A:
Anh Le 10.0
Hang Pham 12
Ly Ton 14.5
Bich Hang Le 9
ở đây, format dùng không đồng đều cho phần số, khi thì 1 decimal place, khi thì không có gi cả
ví dụ:
Anh Le 10.0 (1 decimal place: .0)
Ly Ton 14.5(1 decimal place: .5)
còn
Hang Pham 12 (khong co decimal place nào hết)
Bich Hang Le 9 (khong co decimal place nào hết)
tôi muốn sửa lại cho đồng đều, thống nhất 1 decimal place.
nghĩa là thêm vào Hang Pham 12.0, Bich Hang Le 9.0
không biết có rõ nghĩa chưa. Nếu chưa cho tôi biết mà diễn đạt lại.
Xin cám ơn chị Hyen17 đã nêu vấn đề.

 

[ChanhTQ@]

[thongbao](2) Tôi muốn sửa lại cho đồng đều, thống nhất 1 decimal place.
nghĩa là thêm vào Hang Pham 12.0, Bich Hang Le 9.0
không biết có rõ nghĩa chưa. Nếu chưa cho tôi biết mà diễn đạt lại.
(1) Xin cám ơn chị Hyen17 đã nêu vấn đề.[/thongbao]

(1) Không fải chị đâu! Ngoài chuyện là đực rựa, còn là thằng cha già khằng khú đế nữa!

(2) Bạn thử mở bộ thu macro lên & thực hiện các động tác sau:

Bằng chuộc, tô chọn vùng cần định dạng;

Tiến hành định dạng theo í;

Đưa lên diễn đàn nếu bạn thấy việc sửa chữa macro đã thu chưa được ưng í!

(húc thành công nhân dịp xuân zề!

 

[dugia97]

Thật là bé cái lầm, lướt mạng thương gặp tai nạn anh chị, cô chú. Sorry bác Hyen17.
Đang thử tạo macro theo lới bác ChanhTQ.
Cám ơn bác ChanhTQ.

 

[dugia97]

Bác ChanhTQ kính mến
Cháu đã thực hiện theo toa bác sĩ ghi :
1-tô chọn vùng cần định dạng
Sub Macro1()
Range("A2:A5").Select
End Sub
2-Tiến hành định dạng theo í
Sub Macro2()
Range("A3").Select
ActiveCell.FormulaR1C1 = "Hang Pham 12.0"
End Sub
nhưng vẫn không thấy sợi chỉ liên hệ chi chi giữa hai macro trên cả bác ơi.
đã một tuần rồi, ý một đường code một nẻo.
Bác nới sơi chỉ một tí nữa đươc không?
Cám ơn bác

 

[dugia97]

Bác ChanhTQ kinh mến
Cháu đã nàm đươc rồi, bác xem cần thay đổi gì không ?
Cháu nàm nhu sau:
1-- ở cột B viết công thức :=RIGHT(A2,2)
2-- ở cột C viết công thức :=LEFT(B2,1)
3-- ở cột D viết công thức :=IF(C2=".",A2,CONCATENATE(A2,".0"))
cháu cũng biết là dài dòng, nhưng trí óc cháu chỉ có thế thôi (IQ=77), thật là hú vía nàm được chứ nếu găp bac ChanhTQ ngay lúc phút đâu gieo duyên với GPE thì xem như lần cuối chào nhau rồi đó!!!
Anyway cũng cám ơn bác dù sự chỉ dẫn không đúng với việc cháu phát hiện.