Tô màu trong bảng tính

Liên hệ QC
T

TRANTHEJP

Thành viên mới
Tham gia
20/2/20
Bài viết
9
Được thích
0
Xin chào tất cả mọi người!
Mình là thành viên mới, rất mong được tất cả anh em trên cộng đồng giúp đỡ.
Hiện tại mình đang lập một bảng theo dõi ngày phép và đang gặp phải vấn đề về tô màu vùng dữ liệu
ở công ty mình theo dõi ngày nghỉ phép theo năm và số lượng nhân viên cũng tương đối nhiều ( hơn 400 nhân viên) nên nhập thủ công thì mất thời gian và khả năng sai sót rất cao, nên nhờ mọi người giúp đỡ đặt công thức và định dạng theo yêu cầu sau:
1. Tô màu 12 tháng kể từ ngày bắt đầu tính phép ( Ví dụ Nguyễn Van A có ngày bắt đầu tính phép là 3/3/2020 thì sẽ tô màu từ tháng 3 năm nay đến tháng 2 năm sau)
2. Tô màu để biết được thời gian cập nhật phép năm sau ( Ví dụ Nguyễn Van A sẽ tô màu cam ở tháng 3 năm 2021)
Đại khái là như thế.

Mình gửi File nhập thủ công mong mọi người giúp đỡ.
 

File đính kèm

  • PHEP.xlsx
    13.5 KB · Đọc: 12
TRANTHEJP đã viết:
Xin chào tất cả mọi người!
Mình là thành viên mới, rất mong được tất cả anh em trên cộng đồng giúp đỡ.
Hiện tại mình đang lập một bảng theo dõi ngày phép và đang gặp phải vấn đề về tô màu vùng dữ liệu
ở công ty mình theo dõi ngày nghỉ phép theo năm và số lượng nhân viên cũng tương đối nhiều ( hơn 400 nhân viên) nên nhập thủ công thì mất thời gian và khả năng sai sót rất cao, nên nhờ mọi người giúp đỡ đặt công thức và định dạng theo yêu cầu sau:
1. Tô màu 12 tháng kể từ ngày bắt đầu tính phép ( Ví dụ Nguyễn Van A có ngày bắt đầu tính phép là 3/3/2020 thì sẽ tô màu từ tháng 3 năm nay đến tháng 2 năm sau)
2. Tô màu để biết được thời gian cập nhật phép năm sau ( Ví dụ Nguyễn Van A sẽ tô màu cam ở tháng 3 năm 2021)
Đại khái là như thế.

Mình gửi File nhập thủ công mong mọi người giúp đỡ.
Nhấp chuột vào đây để mở rộng...
Công thức thì không thể tô màu, trừ phi công thức trong Conditional Formatting.
Hơn 400 nhân viên dùng công thức cho CF e rằng sẽ làm file bị "Rùa".
Nếu sử dụng VBA để tô màu thì bạn xem thử file này.
 

File đính kèm

  • PHEP.xlsb
    30.3 KB · Đọc: 33
Code trên của Thầy Ba Tê vẫn chưa hiệu quả.

Bạn thử sử dụng Hàm dưới đây để tô màu.

A1 (Ô bất kì ngoài vùng) = SetColorDaysOffInYear(C6:AA10000,D5:AA5,6,7)

C6:AA10000 - Vùng chứa ngày bắt đầu và ngày phép sử dụng.
D5:AA5 - Vùng của các Tháng để so sánh.
6 - Thứ tự màu của 12 tháng sẽ tô.
7 - Thứ tự màu của năm phép tiếp theo.


---------- Copy Code dưới vào một Module ----------
PHP: 
Public Function SetColorDaysOffInYear(ByVal RngDate As Range, _
                               ByVal RngMonths As Range, _
                            Optional ColorIndex1 As Long = 6, _
                            Optional ColorIndex2 As Long = 7) As String
  Static IsRun As Boolean
  If Not IsRun Then
    IsRun = True
  Else
    Dim Var1  As String, Var2 As String
    Var1 = "'[" & RngDate.Parent.Parent.Name & "]" & _
           RngDate.Parent.Name & "'!" & RngDate.Address(0, 0)
    Var2 = "'[" & RngMonths.Parent.Parent.Name & "]" & _
           RngMonths.Parent.Name & "'!" & _
           RngMonths.Address(0, 0)
    Application.Evaluate "Callback_ToMau(" & _
            Var1 & "," & _
            Var2 & "," & _
            CStr(ColorIndex1) & "," & _
            CStr(ColorIndex2) & " )"
    IsRun = False
  End If
  SetColorDaysOffInYear = "SetColorDaysOffInYear"
End Function


Public Sub Callback_ToMau(ByVal RngDate As Range, _
                          ByVal RngMonths As Range, _
                       Optional ColorIndex1 As Long = 6, _
                       Optional ColorIndex2 As Long = 7)
 
  Dim Arr(), Rng As Range, Cll As Range, J As Long, D As Long
  Dim R1 As Range, R2 As Range, UB As Long, UB2 As Long
  UB = RngDate.Rows.Count
  UB2 = RngMonths.Columns.Count
  Arr = RngMonths(1, 1).Resize(, UB2).Value2
  Set Rng = RngDate(1, 1).Resize(RngDate(UB, 1).End(xlUp).Row)
 
  Dim IsUp As Boolean
  IsUp = Application.ScreenUpdating
  Application.ScreenUpdating = False
  Rng(1, 2).Resize(UB, UB2).Interior.ColorIndex = 0
  For Each Cll In Rng
    D = DateSerial(Year(Cll), Month(Cll), 1)
    For J = 1 To UB2
      If Arr(1, J) = D Then
        If R1 Is Nothing Then
          Set R1 = Cll.Offset(, J).Resize(, 12)
          Set R2 = Cll.Offset(, J + 12)
        Else
          Set R1 = Application.Union(R1, Cll.Offset(, J).Resize(, 12))
          Set R2 = Application.Union(R2, Cll.Offset(, J + 12))
        End If
        Exit For
      End If
    Next J
  Next Cll
  If Not R1 Is Nothing Then
    R1.Interior.ColorIndex = ColorIndex1
    R2.Interior.ColorIndex = ColorIndex2
  End If
  Set R1 = Nothing
  Set R2 = Nothing
  Set Rng = Nothing
  Set Cll = Nothing
  Application.ScreenUpdating = IsUp
End Sub
 
Cảm ơn bạn Ba Te đã giúp đỡ,
Mình muốn biết làm thế nào để tạo được lệnh đó ( ý là mã code của nút bấm đó)
Bài đã được tự động gộp:

HeSanbi đã viết:
Code trên của Thầy Ba Tê vẫn chưa hiệu quả.

Bạn thử sử dụng Hàm dưới đây để tô màu.

A1 (Ô bất kì ngoài vùng) = SetColorDaysOffInYear(C6:AA10000,D5:AA5,6,7)

C6:AA10000 - Vùng chứa ngày bắt đầu và ngày phép sử dụng.
D5:AA5 - Vùng của các Tháng để so sánh.
6 - Thứ tự màu của 12 tháng sẽ tô.
7 - Thứ tự màu của năm phép tiếp theo.


---------- Copy Code dưới vào một Module ----------
PHP: 
Public Function SetColorDaysOffInYear(ByVal RngDate As Range, _
                               ByVal RngMonths As Range, _
                            Optional ColorIndex1 As Long = 6, _
                            Optional ColorIndex2 As Long = 7) As String
  Static IsRun As Boolean
  If Not IsRun Then
    IsRun = True
  Else
    Dim Var1  As String, Var2 As String
    Var1 = "'[" & RngDate.Parent.Parent.Name & "]" & _
           RngDate.Parent.Name & "'!" & RngDate.Address(0, 0)
    Var2 = "'[" & RngMonths.Parent.Parent.Name & "]" & _
           RngMonths.Parent.Name & "'!" & _
           RngMonths.Address(0, 0)
    Application.Evaluate "Callback_ToMau(" & _
            Var1 & "," & _
            Var2 & "," & _
            CStr(ColorIndex1) & "," & _
            CStr(ColorIndex2) & " )"
    IsRun = False
  End If
  SetColorDaysOffInYear = "SetColorDaysOffInYear"
End Function


Public Sub Callback_ToMau(ByVal RngDate As Range, _
                          ByVal RngMonths As Range, _
                       Optional ColorIndex1 As Long = 6, _
                       Optional ColorIndex2 As Long = 7)

  Dim Arr(), Rng As Range, Cll As Range, J As Long, D As Long
  Dim R1 As Range, R2 As Range, UB As Long, UB2 As Long
  UB = RngDate.Rows.Count
  UB2 = RngMonths.Columns.Count
  Arr = RngMonths(1, 1).Resize(, UB2).Value2
  Set Rng = RngDate(1, 1).Resize(RngDate(UB, 1).End(xlUp).Row)

  Dim IsUp As Boolean
  IsUp = Application.ScreenUpdating
  Application.ScreenUpdating = False
  Rng(1, 2).Resize(UB, UB2).Interior.ColorIndex = 0
  For Each Cll In Rng
    D = DateSerial(Year(Cll), Month(Cll), 1)
    For J = 1 To UB2
      If Arr(1, J) = D Then
        If R1 Is Nothing Then
          Set R1 = Cll.Offset(, J).Resize(, 12)
          Set R2 = Cll.Offset(, J + 12)
        Else
          Set R1 = Application.Union(R1, Cll.Offset(, J).Resize(, 12))
          Set R2 = Application.Union(R2, Cll.Offset(, J + 12))
        End If
        Exit For
      End If
    Next J
  Next Cll
  If Not R1 Is Nothing Then
    R1.Interior.ColorIndex = ColorIndex1
    R2.Interior.ColorIndex = ColorIndex2
  End If
  Set R1 = Nothing
  Set R2 = Nothing
  Set Rng = Nothing
  Set Cll = Nothing
  Application.ScreenUpdating = IsUp
End Sub
Nhấp chuột vào đây để mở rộng...


Cái này là dùng luôn cái file mà bạn Ba Te up lên phải không bạn nhỉ?
Nói thật mình mù tịt về mấy cái món VB này
 
Cảm ơn bạn Ba Tê ( lần này chắc viết đúng :):):)) rất nhiều
Cái này mà chèn thêm cột vào là không được bạn nhỉ?
 
Xin cảm ơn mọi người đã giúp đỡ!
Nếu có khó khăn gì không giải quyết được, rất mong sự tư vấn của mọi người!
 
TRANTHEJP đã viết:
Cái này là dùng luôn cái file mà bạn Ba Te up lên phải không bạn nhỉ?
Nhấp chuột vào đây để mở rộng...
----------


Nếu bạn chưa biết sử dụng Code VBA:

Trong file của bạn, mở trình chỉnh sửa Macro VBA bằng cách Ấn tổ hợp phím Alt+F11, hoặc mở Tab Developer và mở VBE

Thêm một Module bằng cách chuột phải vào tên book của bạn đang muốn thực hiện chọn Insert chọn Module và copy đoạn code trên vào Module đấy, sau đó viết công thức hàm vào Sheet và lưu lại ở các dạng chứa Macro như .xls , .xlsm, .xlsb.
 
HeSanbi đã viết:
----------


Nếu bạn chưa biết sử dụng Code VBA:

Trong file của bạn, mở trình chỉnh sửa Macro VBA bằng cách Ấn tổ hợp phím Alt+F11, hoặc mở Tab Developer và mở VBE

Thêm một Module bằng cách chuột phải vào tên book của bạn đang muốn thực hiện chọn Insert chọn Module và copy đoạn code trên vào Module đấy, sau đó viết công thức hàm vào Sheet và lưu lại ở các dạng chứa Macro như .xls , .xlsm, .xlsb.
Nhấp chuột vào đây để mở rộng...

Xin lỗi lại làm phiền bạn.
Mình vẫn không thể làm được cái như bạn hướng dẫn. Từ file mình up lên bạn có thể tạo hàm hộ mình được không?
Mình loay hoay mấy hôm mà không được.
 
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

A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
1
Đọc
22
Hoàng Tuấn 868
H
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
11
Đọc
148
VetMini
V
N
Xin code tính tổng số cấu đúng viết trong "Visual Basic" trong PPT
Trả lời
1
Đọc
4K
hahuy_hien2000
H
8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
3
Đọc
82
HieuCD
H
LuuAnh980
Sao Filter của Excel kỳ lạ.
Trả lời
9
Đọc
91
Hoàng Tuấn 868
H
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