Code lấy mã màu của 1 cell như thế nào ? (1 người xem)

[emgaingayngo]

Để tạo 1 mảng 2 chiều chứa mã màu tôi dùng code như sau :

Sub TaoMangMau()
Dim i As Long, j As Long
Dim mang()
ReDim mang(1 To Selection.Rows.Count, 1 To Selection.Columns.Count)
For i = 1 To Selection.Columns.Count
   For j = 1 To Selection.Rows.Count
   mang(j, i) = Cells(j + Selection.Row - 1, i + Selection.Column - 1).Interior.Color
Next j, i
MsgBox mang(2, 1)
End Sub

Sub TaoMangMau1()
Dim tongdong As Long, tongcot As Long
Dim mang()
tongdong = Selection.Rows.Count: tongcot = Selection.Columns.Count
ReDim mang(1 To tongdong, 1 To tongcot)
mang = Selection.Interior.Color
MsgBox mang(1, 1)
End Sub

Đoạn mã thứ 2 thì báo lỗi "type mismatch". Xin hỏi có cách nào không cần dùng for mà vẫn làm công việc kia được không hoặc là có giải pháp nào tốc đọ nhanh hơn ?

 

[ndu96081631]

Để tạo 1 mảng 2 chiều chứa mã màu tôi dùng code như sau :

Sub TaoMangMau()
Dim i As Long, j As Long
Dim mang()
ReDim mang(1 To Selection.Rows.Count, 1 To Selection.Columns.Count)
For i = 1 To Selection.Columns.Count
   For j = 1 To Selection.Rows.Count
   mang(j, i) = Cells(j + Selection.Row - 1, i + Selection.Column - 1).Interior.Color
Next j, i
MsgBox mang(2, 1)
End Sub

Sub TaoMangMau1()
Dim tongdong As Long, tongcot As Long
Dim mang()
tongdong = Selection.Rows.Count: tongcot = Selection.Columns.Count
ReDim mang(1 To tongdong, 1 To tongcot)
mang = Selection.Interior.Color
MsgBox mang(1, 1)
End Sub

Đoạn mã thứ 2 thì báo lỗi "type mismatch". Xin hỏi có cách nào không cần dùng for mà vẫn làm công việc kia được không hoặc là có giải pháp nào tốc đọ nhanh hơn ?

Vầy cho khỏe:

[COLOR=#ff0000]Function ColorArray(ByVal rng As Range)
  Dim lR As Long, lC As Long, lRs As Long, lCs As Long
  lRs = rng.Rows.Count: lCs = rng.Columns.Count
  ReDim arr(1 To lRs, 1 To lCs)
  For lR = 1 To lRs
    For lC = 1 To lCs
      arr(lR, lC) = rng(lR, lC).Interior.ColorIndex
    Next
  Next
  ColorArray = arr
End Function[/COLOR]
[COLOR=#0000cd]Sub TaoMangMau1()
  Dim arr
  arr = ColorArray(Selection)
  MsgBox arr(1, 1)
End Sub[/COLOR]

Chổ màu xanh là chổ ta áp dụng. Chổ màu đỏ là hàm tự tạo, khỏi cần để ý đến

 

[emgaingayngo]

Vầy cho khỏe:

Chổ màu xanh là chổ ta áp dụng. Chổ màu đỏ là hàm tự tạo, khỏi cần để ý đến

Cảm ơn anh. Cách của anh cũng giống như đoạn mã thứ 1 của em nhưng nó nhanh hơn . ý em là ở đoạn mã 2 em gán câu lệnh :

mang = Selection.Interior.Color

thì nó báo lỗi. Bình thường thì

mang = Selection

thì excel sẽ gán giá trị của cell vào mảng (cái này chắc là mặc định). Vậy có cách nào mà mình dùng câu lệnh tương tự như vậy để lấy mã màu không anh. Cảm ơn anh.

 

[vu_tuan_manh_linh]

Cảm ơn anh. Cách của anh cũng giống như đoạn mã thứ 1 của em nhưng nó nhanh hơn . ý em là ở đoạn mã 2 em gán câu lệnh :

Thế này mới đúng chứ bạn: mang = Selection.Interior.Colorindex

 

[Quang_Hải]

Thế này mới đúng chứ bạn: mang = Selection.Interior.Colorindex

Làm sao mà gán như vậy được chứ??? Hic

 

[ndu96081631]

Cảm ơn anh. Cách của anh cũng giống như đoạn mã thứ 1 của em nhưng nó nhanh hơn . ý em là ở đoạn mã 2 em gán câu lệnh :

mang = Selection.Interior.Color

thì nó báo lỗi. Bình thường thì

mang = Selection

thì excel sẽ gán giá trị của cell vào mảng (cái này chắc là mặc định). Vậy có cách nào mà mình dùng câu lệnh tương tự như vậy để lấy mã màu không anh. Cảm ơn anh.

Sao mà gán kiểu đó được, gán xong nó đâu có thành 1 mảng
Bạn có thể thí nghiệm:

Sub Test()
 Dim rng As Range
 Set rng = Selection
 Dim arr
 arr = rng.Interior.Color
 MsgBox IsArray(arr), , TypeName(arr)
End Sub

Tóm lại: thuộc tính .Interior.Color hoặc .Interior.ColorIndex cũng chỉ trả về kết quả là 1 giá trị, không bao giờ là 1 mảng cả
Cũng giống như: Range(...).Value có thể là 1 mảng nhưng Range(...).Text thì không bao giờ là mảng

 

[emgaingayngo]

Vậy là excel nó không cho mình chơi kiểu này rồi. Nó chỉ cho lấy giá trị trong cell thôi và nếu như là màu hoặc cái gì khác thì chỉ cho lấy giá trị của 1 cell thôi. Hic.