Nhờ viết code tô màu theo điều kiện

Liên hệ QC
echo07

echo07

Nguyệt Hà
Tham gia
24/8/07
Bài viết
435
Được thích
318
Chào cả nhà. Với đầu bài này thì áp dụng tính năng định dạng theo điều kiện có thể xử lý dễ dàng nhưng em muốn thử bằng code xem thế nào, mong mọi người giúp đỡ ạ.
 

File đính kèm

  • Nho viet code.xlsx
    11.5 KB · Đọc: 33
Sắp xếp theo thời gian sắp xếp theo bầu chọn
echo07 đã viết:
Chào cả nhà. Với đầu bài này thì áp dụng tính năng định dạng theo điều kiện có thể xử lý dễ dàng nhưng em muốn thử bằng code xem thế nào, mong mọi người giúp đỡ ạ.
Nhấp chuột vào đây để mở rộng...
Bạn tham khảo.
ColourCode thì Record Macro để lấy thông số đúng bạn nhé!

PHP: 
Sub FillColours()
    Dim SourceRng As Range
    Dim I As Integer, J As Integer, ColourCode As Long
    
    Set SourceRng = Sheet1.Range("A1").CurrentRegion
    
    For I = 2 To SourceRng.Rows.Count
        If SourceRng(I, 3) = 1 Then
            ColourCode = 65535
        ElseIf SourceRng(I, 3) = 2 Then
            ColourCode = 65280
        Else
            ColourCode = 49407
        End If
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
        SourceRng(I, J).Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
    Next I
    
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Bạn tham khảo.
ColourCode thì Record Macro để lấy thông số đúng bạn nhé!

PHP: 
Sub FillColours()
    Dim SourceRng As Range
    Dim I As Integer, J As Integer, ColourCode As Long
   
    Set SourceRng = Sheet1.Range("A1").CurrentRegion
   
    For I = 2 To SourceRng.Rows.Count
        If SourceRng(I, 3) = 1 Then
            ColourCode = 65535
        ElseIf SourceRng(I, 3) = 2 Then
            ColourCode = 65280
        Else
            ColourCode = 49407
        End If
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
        SourceRng(I, J).Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
    Next I
   
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá, xin phép mượn luôn chủ đề của Topic nhờ bạn viết giúp như sau.
 

File đính kèm

  • Nho viet code.xlsx
    11.2 KB · Đọc: 14
Upvote 0
nvh611 đã viết:
Hay quá, xin phép mượn luôn chủ đề của Topic nhờ bạn viết giúp như sau.
Nhấp chuột vào đây để mở rộng...
Code cho Sheet1
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 5 Then
        Call FillColours
    End If
End Sub
Code cho Module:
Mã: 
Sub FillColours()
    Dim SourceRng As Range
    Dim I As Integer, J As Integer, ColourCode As Long
    
    Application.ScreenUpdating = False
    
    Set SourceRng = Sheet1.Range("A1").CurrentRegion
    
    For I = 2 To SourceRng.Rows.Count
        If SourceRng(I, 5) = 1 Then
            ColourCode = 65535
        ElseIf SourceRng(I, 5) = 2 Then
            ColourCode = 65280
        Else
            ColourCode = 49407
        End If
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
        SourceRng(I, J) = SourceRng(1, 3) & "(" & SourceRng(I, 3) & ")-" & SourceRng(1, 4) & "(" & SourceRng(I, 4) & ")"
        SourceRng(I, J).Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
    Next I
    
    Set SourceRng = Nothing
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Code cho Sheet1
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 5 Then
        Call FillColours
    End If
End Sub
Code cho Module:
Mã: 
Sub FillColours()
    Dim SourceRng As Range
    Dim I As Integer, J As Integer, ColourCode As Long
   
    Application.ScreenUpdating = False
   
    Set SourceRng = Sheet1.Range("A1").CurrentRegion
   
    For I = 2 To SourceRng.Rows.Count
        If SourceRng(I, 5) = 1 Then
            ColourCode = 65535
        ElseIf SourceRng(I, 5) = 2 Then
            ColourCode = 65280
        Else
            ColourCode = 49407
        End If
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
        SourceRng(I, J) = SourceRng(1, 3) & "(" & SourceRng(I, 3) & ")-" & SourceRng(1, 4) & "(" & SourceRng(I, 4) & ")"
        SourceRng(I, J).Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
    Next I
   
    Set SourceRng = Nothing
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Hay quá, tiếc rằng lúc còn trẻ chưa về hưu tôi cứ loay hoay tô màu theo điều kiện bằng công thức và làm bằng phần mềm Project
Nói thật sự cái phần mềm Project không linh hoạt bằng mình làm bằng excel
Bây giờ mới biết đến VBa thì đã hết thời
Chắc thêm mấy cái mũi tên vào biểu đồ thì quá đỉnh.
Cảm ơn bạn nhé.
 
Upvote 0
nvh611 đã viết:
Hay quá, tiếc rằng lúc còn trẻ chưa về hưu tôi cứ loay hoay tô màu theo điều kiện bằng công thức và làm bằng phần mềm Project
Nói thật sự cái phần mềm Project không linh hoạt bằng mình làm bằng excel
Bây giờ mới biết đến VBa thì đã hết thời
Chắc thêm mấy cái mũi tên vào biểu đồ thì quá đỉnh.
Cảm ơn bạn nhé.
Nhấp chuột vào đây để mở rộng...
Bác cứ đưa thêm yêu cầu, sát thực tế là tốt nhất.
Như vậy mọi người sẽ có thêm kiến thức thực tế để áp dụng.
Ai muốn giúp đỡ cũng thêm cơ hội thực hành.
 
Upvote 0
vanthinh3101 đã viết:
Bác cứ đưa thêm yêu cầu, sát thực tế là tốt nhất.
Như vậy mọi người sẽ có thêm kiến thức thực tế để áp dụng.
Ai muốn giúp đỡ cũng thêm cơ hội thực hành.
Nhấp chuột vào đây để mở rộng...
Vậy nhờ bạn chỉnh tiếp nhé
Tất nhiên là sẽ có nhiều phần chi tiết và đa năng hơn nữa, nhưng bạn chỉnh thêm 2 phần này thì tiến độ cũng tương đối
Còn chi tiết hơn thì tính sau
Cảm ơn bạn
 

File đính kèm

  • Nho viet code(Tiến độ).xlsb
    19.1 KB · Đọc: 20
Upvote 0
nvh611 đã viết:
Vậy nhờ bạn chỉnh tiếp nhé
Tất nhiên là sẽ có nhiều phần chi tiết và đa năng hơn nữa, nhưng bạn chỉnh thêm 2 phần này thì tiến độ cũng tương đối
Còn chi tiết hơn thì tính sau
Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...
Như ví dụ bác đưa thì em phải hỏi thêm
- Phần chuyển công tác 1 --> 6 có phải là từ dòng 1 xuống dòng 6 hay không?
- Ở dòng 6, tại sao ngày bắt đầu là 10/10/2021 mà tô màu bắt đầu từ 12/10/2021
 
Upvote 0
vanthinh3101 đã viết:
Như ví dụ bác đưa thì em phải hỏi thêm
- Phần chuyển công tác 1 --> 6 có phải là từ dòng 1 xuống dòng 6 hay không?
- Ở dòng 6, tại sao ngày bắt đầu là 10/10/2021 mà tô màu bắt đầu từ 12/10/2021
Nhấp chuột vào đây để mở rộng...
À cái đó là do mình chèn thêm cột vào nên bị sai đấy
1-->6 tức là chuyển từ dòng (Hiện tại là dòng số 1 chuyển xuống công tác 6 "Tức là theo số thứ tự mà bạn đánh đấy)
Tương tự 3---> 5 tức là chuyển từ dòng 3 xuống dòng 5 (Chú ý là theo thứ tự đầu công việc nhé)
 
Upvote 0
nvh611 đã viết:
À cái đó là do mình chèn thêm cột vào nên bị sai đấy
1-->6 tức là chuyển từ dòng (Hiện tại là dòng số 1 chuyển xuống công tác 6 "Tức là theo số thứ tự mà bạn đánh đấy)
Tương tự 3---> 5 tức là chuyển từ dòng 3 xuống dòng 5 (Chú ý là theo thứ tự đầu công việc nhé)
Nhấp chuột vào đây để mở rộng...
Gửi bác,
Em cố hết sức làm tổng quát.
Cần khá nhiều các thủ tục/hàm con
Chi tiết như sau:
1. Thủ tục xóa các mũi tên cũ
Mã: 
'-----Xoa Shape mui ten trong sheet
Public Sub DeleteArrows(Ws As Worksheet)
    Dim shp As Object
    
    For Each shp In Ws.Shapes
        If shp.Connector = msoTrue Then
            shp.Delete
        End If
    Next shp
End Sub
2. Thủ tục vẽ mũi tên mới: code sưu tầm
Mã: 
Public Sub DrawArrows(FromRange As Range, ToRange As Range, Optional RGBcolor As Long, Optional LineType As String)
    '---------------------------------------------------------------------------------------------------
    '---Script: DrawArrows------------------------------------------------------------------------------
    '---Created by: Ryan Wells -------------------------------------------------------------------------
    '---Date: 10/2015-----------------------------------------------------------------------------------
    '---Description: This macro draws arrows or lines from the middle of one cell to the middle --------
    '----------------of another. Custom endpoints and shape colors are suppported ----------------------
    '---------------------------------------------------------------------------------------------------
    
    Dim dleft1 As Double, dleft2 As Double
    Dim dtop1 As Double, dtop2 As Double
    Dim dheight1 As Double, dheight2 As Double
    Dim dwidth1 As Double, dwidth2 As Double
    dleft1 = FromRange.Left
    dleft2 = ToRange.Left
    dtop1 = FromRange.Top
    dtop2 = ToRange.Top
    dheight1 = FromRange.Height
    dheight2 = ToRange.Height
    dwidth1 = FromRange.Width
    dwidth2 = ToRange.Width
    
    'expression.AddConnector(Type, BeginX, BeginY, EndX, EndY)
    'ActiveSheet.Shapes.AddConnector( _
        msoConnectorStraight, dleft1 + dwidth1 / 2, _
        dtop1 + dheight1 / 2, dleft2 + dwidth2 / 2, dtop2 + dheight2 / 2).Select
    ActiveSheet.Shapes.AddConnector( _
        msoConnectorStraight, dleft1 + dwidth1, _
        dtop1, dleft2 + dwidth2, dtop2).Select
    'format line
    With Selection.ShapeRange.Line
        .BeginArrowheadStyle = msoArrowheadNone
        .EndArrowheadStyle = msoArrowheadOpen
        .Weight = 2
        .Transparency = 0
        If UCase(LineType) = "DOUBLE" Then 'double arrows
            .BeginArrowheadStyle = msoArrowheadOpen
        ElseIf UCase(LineType) = "LINE" Then 'Line (no arows)
            .EndArrowheadStyle = msoArrowheadNone
        Else 'single arrow
            'defaults to an arrow with one head
        End If
        'color arrow
        If RGBcolor <> 0 Then
            .ForeColor.RGB = RGBcolor 'custom color
        Else
            .ForeColor.RGB = RGB(228, 108, 10)   'orange (DEFAULT)
        End If
    End With
 
End Sub
3. Hàm xác định mã màu
- Viết riêng hàm này để sửa gì thì sửa ngoài hàm, không cần sửa trong code tổng.
- Cú pháp Switch cũng khá đơn giản để sửa
Mã: 
'-----Xac dinh ma mau
Public Function GetColourCode(CheckCondition As Integer) As Long
    GetColourCode = Switch(CheckCondition = 1, 65535, CheckCondition = 2, 65280, True, 49407)
End Function
4. Thủ tục điền thông tin, tô màu tiến độ
Mã: 
Sub GetProcessColour(SourceRng As Range)
    Dim I As Integer, J As Integer, ColourCode As Long
    Dim fRng As Range, tRng As Range
    
    'Chay vong lap tu dong thu 2 cua Vung goc
    For I = 2 To SourceRng.Rows.Count
        'Xac dinh Ma mau
        ColourCode = GetColourCode(CInt(SourceRng(I, 5)))
        'Xac dinh vi tri ngay bat dau cua cong viec tai hang thu nhat cua Vung goc
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
        
        With SourceRng(I, J)
            'Dien thong tin ngay va nhan cong tai o lien truoc can to mau
            .Offset(, -1).Font.Size = 8     'Size chu
            .Offset(, -1) = SourceRng(1, 3) & "(" & SourceRng(I, 3) & ")-" & SourceRng(1, 4) & "(" & SourceRng(I, 4) & ")"
            'Dien so nhan cong
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1) = SourceRng(I, 4)
            'To mau cac ngay thuc hien
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
            'Dieu chinh mau Font chu cung mau cua o
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Font.Color = ColourCode
        End With
        
        'Kiem tra cot Chuyen cong tac co du lieu hay khong de ve mui ten
        If Len(SourceRng(I, 6)) And Len(SourceRng(I, 7)) Then
            If IsNumeric(SourceRng(I, 6)) And IsNumeric(SourceRng(I, 7)) Then
                'O bat dau ve mui ten
                Set fRng = SourceRng(I, J).Offset(, SourceRng(I, 3))
                'O ket thuc ve mui ten
                Set tRng = fRng.Offset(SourceRng(I, 7) - SourceRng(I, 6))
                'Ve mui ten
                Call DrawArrows(fRng, tRng, RGB(50, 46, 218))
            End If
        End If
    Next I
    
    'Dien thong tin dong cuoi cung
    SourceRng(SourceRng.Rows.Count, 1).Offset(1, 9).Resize(, SourceRng.Columns.Count - 9).FormulaR1C1 = "=SUM(R[-1]C:R[" & (1 - SourceRng.Rows.Count) & "]C)"
    SourceRng(1.1).Select
    
    Set fRng = Nothing: Set tRng = Nothing
    
End Sub
5. Thủ tục chính: quan trọng nhất là thông tin ô đầu tiên của vùng dữ liệu cần xử lý
Mã: 
Sub Main()
    Dim sRng As Range
    Dim lR As Integer, lcol As Integer
    Dim bCell As String, fR As Integer, fCol As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    'Dia chi o dau tien cua vung du lieu can xu ly
    bCell = "A$1"  'Co ky tu $ de dung ham van ban tach chi so dong, cot
    fR = Val(Mid(bCell, InStr(1, bCell, "$") + 1))
    fCol = Sheet1.Range(Left(bCell, InStr(1, bCell, "$") - 1) & ":" & Left(bCell, InStr(1, bCell, "$") - 1)).Column
    
    'Xac dinh dong cuoi
    lR = Sheet1.Range(Left(bCell, InStr(1, bCell, "$") - 1) & Rows.Count).End(xlUp).Row
    'Xac dinh cot cuoi
    lcol = Sheet1.Cells(fR, Columns.Count).End(xlToLeft).Column
    
    'Vung chua toan bo du lieu
    Set sRng = Sheet1.Range(bCell).Resize(lR - fR + 1, lcol - fCol + 1)
    'Xoa dinh dang va thong tin cu
    sRng.Offset(1, 8).Clear
    'Xoa cac mui ten cu
    Call DeleteArrows(Sheet1)
    'Chay ket qua moi
    Call GetProcessColour(sRng)
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Done", vbInformation, "GPE"
End Sub

Bác xem có vấn đề gì cần sửa lại để cập nhật tiếp nhé!
 

File đính kèm

  • Nho viet code(Tiến độ).xlsb
    33.1 KB · Đọc: 19
Upvote 0
vanthinh3101 đã viết:
Gửi bác,
Em cố hết sức làm tổng quát.
Cần khá nhiều các thủ tục/hàm con
Chi tiết như sau:
1. Thủ tục xóa các mũi tên cũ
Mã: 
'-----Xoa Shape mui ten trong sheet
Public Sub DeleteArrows(Ws As Worksheet)
    Dim shp As Object
   
    For Each shp In Ws.Shapes
        If shp.Connector = msoTrue Then
            shp.Delete
        End If
    Next shp
End Sub
2. Thủ tục vẽ mũi tên mới: code sưu tầm
Mã: 
Public Sub DrawArrows(FromRange As Range, ToRange As Range, Optional RGBcolor As Long, Optional LineType As String)
    '---------------------------------------------------------------------------------------------------
    '---Script: DrawArrows------------------------------------------------------------------------------
    '---Created by: Ryan Wells -------------------------------------------------------------------------
    '---Date: 10/2015-----------------------------------------------------------------------------------
    '---Description: This macro draws arrows or lines from the middle of one cell to the middle --------
    '----------------of another. Custom endpoints and shape colors are suppported ----------------------
    '---------------------------------------------------------------------------------------------------
   
    Dim dleft1 As Double, dleft2 As Double
    Dim dtop1 As Double, dtop2 As Double
    Dim dheight1 As Double, dheight2 As Double
    Dim dwidth1 As Double, dwidth2 As Double
    dleft1 = FromRange.Left
    dleft2 = ToRange.Left
    dtop1 = FromRange.Top
    dtop2 = ToRange.Top
    dheight1 = FromRange.Height
    dheight2 = ToRange.Height
    dwidth1 = FromRange.Width
    dwidth2 = ToRange.Width
   
    'expression.AddConnector(Type, BeginX, BeginY, EndX, EndY)
    'ActiveSheet.Shapes.AddConnector( _
        msoConnectorStraight, dleft1 + dwidth1 / 2, _
        dtop1 + dheight1 / 2, dleft2 + dwidth2 / 2, dtop2 + dheight2 / 2).Select
    ActiveSheet.Shapes.AddConnector( _
        msoConnectorStraight, dleft1 + dwidth1, _
        dtop1, dleft2 + dwidth2, dtop2).Select
    'format line
    With Selection.ShapeRange.Line
        .BeginArrowheadStyle = msoArrowheadNone
        .EndArrowheadStyle = msoArrowheadOpen
        .Weight = 2
        .Transparency = 0
        If UCase(LineType) = "DOUBLE" Then 'double arrows
            .BeginArrowheadStyle = msoArrowheadOpen
        ElseIf UCase(LineType) = "LINE" Then 'Line (no arows)
            .EndArrowheadStyle = msoArrowheadNone
        Else 'single arrow
            'defaults to an arrow with one head
        End If
        'color arrow
        If RGBcolor <> 0 Then
            .ForeColor.RGB = RGBcolor 'custom color
        Else
            .ForeColor.RGB = RGB(228, 108, 10)   'orange (DEFAULT)
        End If
    End With
 
End Sub
3. Hàm xác định mã màu
- Viết riêng hàm này để sửa gì thì sửa ngoài hàm, không cần sửa trong code tổng.
- Cú pháp Switch cũng khá đơn giản để sửa
Mã: 
'-----Xac dinh ma mau
Public Function GetColourCode(CheckCondition As Integer) As Long
    GetColourCode = Switch(CheckCondition = 1, 65535, CheckCondition = 2, 65280, True, 49407)
End Function
4. Thủ tục điền thông tin, tô màu tiến độ
Mã: 
Sub GetProcessColour(SourceRng As Range)
    Dim I As Integer, J As Integer, ColourCode As Long
    Dim fRng As Range, tRng As Range
   
    'Chay vong lap tu dong thu 2 cua Vung goc
    For I = 2 To SourceRng.Rows.Count
        'Xac dinh Ma mau
        ColourCode = GetColourCode(CInt(SourceRng(I, 5)))
        'Xac dinh vi tri ngay bat dau cua cong viec tai hang thu nhat cua Vung goc
        J = Application.Match(SourceRng(I, 1), SourceRng.Resize(1), 0)
       
        With SourceRng(I, J)
            'Dien thong tin ngay va nhan cong tai o lien truoc can to mau
            .Offset(, -1).Font.Size = 8     'Size chu
            .Offset(, -1) = SourceRng(1, 3) & "(" & SourceRng(I, 3) & ")-" & SourceRng(1, 4) & "(" & SourceRng(I, 4) & ")"
            'Dien so nhan cong
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1) = SourceRng(I, 4)
            'To mau cac ngay thuc hien
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Interior.Color = ColourCode
            'Dieu chinh mau Font chu cung mau cua o
            .Resize(, SourceRng(I, 2) - SourceRng(I, 1) + 1).Font.Color = ColourCode
        End With
       
        'Kiem tra cot Chuyen cong tac co du lieu hay khong de ve mui ten
        If Len(SourceRng(I, 6)) And Len(SourceRng(I, 7)) Then
            If IsNumeric(SourceRng(I, 6)) And IsNumeric(SourceRng(I, 7)) Then
                'O bat dau ve mui ten
                Set fRng = SourceRng(I, J).Offset(, SourceRng(I, 3))
                'O ket thuc ve mui ten
                Set tRng = fRng.Offset(SourceRng(I, 7) - SourceRng(I, 6))
                'Ve mui ten
                Call DrawArrows(fRng, tRng, RGB(50, 46, 218))
            End If
        End If
    Next I
   
    'Dien thong tin dong cuoi cung
    SourceRng(SourceRng.Rows.Count, 1).Offset(1, 9).Resize(, SourceRng.Columns.Count - 9).FormulaR1C1 = "=SUM(R[-1]C:R[" & (1 - SourceRng.Rows.Count) & "]C)"
    SourceRng(1.1).Select
   
    Set fRng = Nothing: Set tRng = Nothing
   
End Sub
5. Thủ tục chính: quan trọng nhất là thông tin ô đầu tiên của vùng dữ liệu cần xử lý
Mã: 
Sub Main()
    Dim sRng As Range
    Dim lR As Integer, lcol As Integer
    Dim bCell As String, fR As Integer, fCol As Integer
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    'Dia chi o dau tien cua vung du lieu can xu ly
    bCell = "A$1"  'Co ky tu $ de dung ham van ban tach chi so dong, cot
    fR = Val(Mid(bCell, InStr(1, bCell, "$") + 1))
    fCol = Sheet1.Range(Left(bCell, InStr(1, bCell, "$") - 1) & ":" & Left(bCell, InStr(1, bCell, "$") - 1)).Column
   
    'Xac dinh dong cuoi
    lR = Sheet1.Range(Left(bCell, InStr(1, bCell, "$") - 1) & Rows.Count).End(xlUp).Row
    'Xac dinh cot cuoi
    lcol = Sheet1.Cells(fR, Columns.Count).End(xlToLeft).Column
   
    'Vung chua toan bo du lieu
    Set sRng = Sheet1.Range(bCell).Resize(lR - fR + 1, lcol - fCol + 1)
    'Xoa dinh dang va thong tin cu
    sRng.Offset(1, 8).Clear
    'Xoa cac mui ten cu
    Call DeleteArrows(Sheet1)
    'Chay ket qua moi
    Call GetProcessColour(sRng)
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Done", vbInformation, "GPE"
End Sub

Bác xem có vấn đề gì cần sửa lại để cập nhậ
Nhấp chuột vào đây để mở rộng...
Về cơ bản tương đối ngon rồi bạn ơi, rất hay và bạn làm rất nhanh.
Ngày xưa để tô màu theo điều kiện tôi phải mày mò nghiên cứu hết sách nọ sách kia mất mấy năm mới tìm ra được cách tô màu theo điều kiện
Thế mà bây giờ bằng VBa mà bạn chỉ làm trong nháy mắt
Nếu về bảng tiến độ thì chỉ cần viết như này thì mọi kỹ sư cũng đã làm được rồi (Nhưng về phần chi tiết và nâng cao thì còn nhiều vấn đề trong này)
-Nếu tô màu cả dòng thì nhìn rất thô (VBa liệu có thể tô màu được 1/3 hay 1/2 dòng không bạn @vanthinh3101 )
Nếu không tô màu được 1 phần của dòng thì phải ghép 3 dòng vào làm 1 và tô dòng ở giữa, lúc này nhìn tiến độ mới đẹp được (Nhưng làm cách này thì điều chỉnh rất khó)
Cảm ơn bạn nhé!
 
Upvote 0
nvh611 đã viết:
Về cơ bản tương đối ngon rồi bạn ơi, rất hay và bạn làm rất nhanh.
Ngày xưa để tô màu theo điều kiện tôi phải mày mò nghiên cứu hết sách nọ sách kia mất mấy năm mới tìm ra được cách tô màu theo điều kiện
Thế mà bây giờ bằng VBa mà bạn chỉ làm trong nháy mắt
Nếu về bảng tiến độ thì chỉ cần viết như này thì mọi kỹ sư cũng đã làm được rồi (Nhưng về phần chi tiết và nâng cao thì còn nhiều vấn đề trong này)
-Nếu tô màu cả dòng thì nhìn rất thô (VBa liệu có thể tô màu được 1/3 hay 1/2 dòng không bạn @vanthinh3101 )
Nếu không tô màu được 1 phần của dòng thì phải ghép 3 dòng vào làm 1 và tô dòng ở giữa, lúc này nhìn tiến độ mới đẹp được (Nhưng làm cách này thì điều chỉnh rất khó)
Cảm ơn bạn nhé!
Nhấp chuột vào đây để mở rộng...
Quan trọng nhất là ý tưởng sáng tạo và đường bước thực hiện.
Bác xem file đính kèm đúng ý chưa?
 

File đính kèm

  • Nho viet code(Tiến độ).xlsb
    34.9 KB · Đọc: 23
Upvote 0
vanthinh3101 đã viết:
Quan trọng nhất là ý tưởng sáng tạo và đường bước thực hiện.
Bác xem file đính kèm đúng ý chưa?
Nhấp chuột vào đây để mở rộng...
Quá hay và quá đẹp bạn @vanthinh3101 cảm ơn bạn nhé, giá như chúng ta gặp nhau sớm.
Cái này cũng đã thừa đủ dùng cho các bạn nào quan tâm rồi.
Còn nhiều vấn đề khác (Nếu bạn nào quan tâm thì nhờ bạn @vanthinh3101 tùy chỉnh giúp cho, nó sẽ linh hoạt hơn thằng Project nhiều lắm đấy)
 

File đính kèm

  • Nho viet code(Tiến độ).xlsb
    35.7 KB · Đọc: 17
Upvote 0
nvh611 đã viết:
Quá hay và quá đẹp bạn @vanthinh3101 cảm ơn bạn nhé, giá như chúng ta gặp nhau sớm.
Cái này cũng đã thừa đủ dùng cho các bạn nào quan tâm rồi.
Còn nhiều vấn đề khác (Nếu bạn nào quan tâm thì nhờ bạn @vanthinh3101 tùy chỉnh giúp cho, nó sẽ linh hoạt hơn thằng Project nhiều lắm đấy)
Nhấp chuột vào đây để mở rộng...
Bạn cho hỏi để tìm các công việc gantt trong tiến độ bạn làm thế nào
 
Upvote 0
CHAOQUAY đã viết:
Chỗ này thì thấy rõ rồi nhưng thay đổi nội dung công việc thì biểu đồ tiến độ vẫn không khác gì, tưởng là biểu đồ phải đổi theo công việc
Nhấp chuột vào đây để mở rộng...
Cái này phải phụ thuộc vào mấy yếu tố điểm bắt đầu và điểm kết thúc bạn nhé
Và ở đây cho cách thay đổi ngay lập tức là cột chỉ định màu đấy bạn.
Để dùng tiện lợi và có nhiều tính năng hơn thì vẫn phải viết thêm nhiều thứ khác nữa
Trên chỉ là những phần cơ bản bạn @vanthinh3101 đã viết
 
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

dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
232
ptm0412
ptm0412
N
Giúp sửa mã code
Trả lời
12
Đọc
186
ptm0412
ptm0412
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
3
Đọc
77
HUONGHCKT
H
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
10 11 12
Trả lời
237
Đọc
12K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
Mr Đạo
in giấy ra bị lệch xuống dưới
    • Thích
2
Trả lời
29
Đọc
26K
Hoàng Tuấn 868
H
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
1
Đọc
27
Hoàng Tuấn 868
H
H
Không xem được ảnh trên Excel
Trả lời
3
Đọc
1K
huyentran9292
H
T
Xin form quản lý dữ liệu học viên của Trung tâm Đào tạo
Trả lời
2
Đọc
201
hakiru188
H
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
6
Đọc
176
Tuấn Bụng Bự
Tuấn Bụng Bự
C
Code Lọc Dữ Liệu
Trả lời
10
Đọc
153
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
107
hoangminhtien
hoangminhtien
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
152
ptm0412
ptm0412
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
12
Đọc
19K
cantl
C
Nguyencaocuong86
Tô màu dữ liệu trùng lặp trong excel.
Trả lời
10
Đọc
132
Nguyencaocuong86
Nguyencaocuong86
Hoangquyenbong
  • Question
Nhờ viết code lọc dữ liệu tại các sheet khác nhau.
Trả lời
12
Đọc
159
Hoangquyenbong
Hoangquyenbong
D
Giúp em công thức lấy mã vật tư gồm 14 số?
Trả lời
3
Đọc
100
hoangminhtien
hoangminhtien
HeSanbi
  • Đã giải quyết
HÀM FITROW - Co giãn dòng tự động tối ưu nhất cho Excel v2.43 (*14/10/2024)
    • Thích
    • Yêu thích
2 3
Trả lời
48
Đọc
21K
HeSanbi
HeSanbi
L
Dùng vlookup đưa kết quả không được
Trả lời
19
Đọc
302
họ nguyễn tên thùy
họ nguyễn tên thùy
Ha Manh-LD
Thêm dòng cho 2 bảng cùng lúc
Trả lời
0
Đọc
56
Ha Manh-LD
Ha Manh-LD
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
1
Đọc
135
Hoàng Tuấn 868
H
Xem thêm…

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