Em xin được sự giúp đỡ :Ẩn dòng và tự động đánh lại số thứ tự (STT) sau khi ẩn dòng

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Xét trong vùng dữ liệu từ cột D đến cột Y:
Nếu tất cả các dòng trong vùng dữ liệu từ cột D đến cột Y đều trống (các ô từ cột D đến cột Y đều không chữa dữ liệu) thì dòng chứa các ô đó sẽ bị ẩn và khi đó ở cột A số thứ tự (STT) tự động được đánh lại cho những dòng không bị ẩn.
Em nhờ sự giúp đỡ của các Thầy, cac Anh, Chị.
Em xin cám ơn!
File cua toi.jpg
 

File đính kèm

ExcelQN

Thành viên hoạt động
Tham gia ngày
7 Tháng năm 2011
Bài viết
134
Được thích
49
Điểm
370
Xét trong vùng dữ liệu từ cột D đến cột Y:
Nếu tất cả các dòng trong vùng dữ liệu từ cột D đến cột Y đều trống (các ô từ cột D đến cột Y đều không chữa dữ liệu) thì dòng chứa các ô đó sẽ bị ẩn và khi đó ở cột A số thứ tự (STT) tự động được đánh lại cho những dòng không bị ẩn.
Em nhờ sự giúp đỡ của các Thầy, cac Anh, Chị.
Em xin cám ơn!
Bạn xem file này thử nhé, tuy nhiên góp ý với bạn là thêm cái nút nhấn vào đó cho nó tự ẩn tất cả các dòng theo mong muốn của bạn, bằng record macro.
 

File đính kèm

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
5,859
Được thích
9,783
Điểm
860
Thêm 1 tham khảo:
PHP:
Sub AnDongKhiKhongCoDuLieu()
 Dim Rws As Long, Dem As Integer
 Dim WF As Object, Rng As Range, STT As Long
 
 Set WF = Application.WorksheetFunction
 Rws = [B2].CurrentRegion.Rows.Count
 Rows("1:" & Rws).Hidden = False
 Application.ScreenUpdating = False
 For J = 2 To Rws
    Set Rng = Range(Cells(J, "D"), Cells(J, "Y"))
    Dem = WF.CountA(Rng)
    If Dem Then
        STT = STT + 1:              Cells(J, "A").Value = STT
    Else
        Rows(J & ":" & J).Hidden = True
    End If
 Next J
 Application.ScreenUpdating = True
 MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thêm 1 tham khảo:
PHP:
Sub AnDongKhiKhongCoDuLieu()
Dim Rws As Long, Dem As Integer
Dim WF As Object, Rng As Range, STT As Long

Set WF = Application.WorksheetFunction
Rws = [B2].CurrentRegion.Rows.Count
Rows("1:" & Rws).Hidden = False
Application.ScreenUpdating = False
For J = 2 To Rws
    Set Rng = Range(Cells(J, "D"), Cells(J, "Y"))
    Dem = WF.CountA(Rng)
    If Dem Then
        STT = STT + 1:              Cells(J, "A").Value = STT
    Else
        Rows(J & ":" & J).Hidden = True
    End If
Next J
Application.ScreenUpdating = True
MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub
Dạ! em cám ơn Thầy, chúc Thầy buổi tối vui vẻ ạ!
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thêm 1 tham khảo:
PHP:
Sub AnDongKhiKhongCoDuLieu()
Dim Rws As Long, Dem As Integer
Dim WF As Object, Rng As Range, STT As Long

Set WF = Application.WorksheetFunction
Rws = [B2].CurrentRegion.Rows.Count
Rows("1:" & Rws).Hidden = False
Application.ScreenUpdating = False
For J = 2 To Rws
    Set Rng = Range(Cells(J, "D"), Cells(J, "Y"))
    Dem = WF.CountA(Rng)
    If Dem Then
        STT = STT + 1:              Cells(J, "A").Value = STT
    Else
        Rows(J & ":" & J).Hidden = True
    End If
Next J
Application.ScreenUpdating = True
MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub
Thầy ơi! Em xin nhờ thầy giúp đỡ em vấn đề phát sinh chút a! hi….
Trong sheet "DIARY"Tương ứng với các công việc ở cột I thì các loại máy móc để thi công công việc đó sẽ được điền vào cột T.
Máy thi công lấy từ bảng trong Sheet "may thi công"
anh dep.jpg
 

File đính kèm

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
5,859
Được thích
9,783
Điểm
860
Thử kiểm tra sau khi cho cái này chạy:
PHP:
Sub GhiThietBiThiCongCanThiet()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 Dim Rws As Long, W As Integer
 
 With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
 End With
 Sheets("May Thi Cong").Select
 For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            Sheets("Diary").Cells(sRng.Row, "T").Value = Cls.Offset(, 1).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thử kiểm tra sau khi cho cái này chạy:
PHP:
Sub GhiThietBiThiCongCanThiet()
Dim Rng As Range, sRng As Range, Cls As Range
Dim MyAdd As String
Dim Rws As Long, W As Integer

With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
End With
Sheets("May Thi Cong").Select
For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            Sheets("Diary").Cells(sRng.Row, "T").Value = Cls.Offset(, 1).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
Next Cls
End Sub
Vâng đúng ý em rồi Thầy ạ! em cám ơn Thầy nhiều, chúc Thầy ngày mới vui vẻ và nhiều may mắn!
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thử kiểm tra sau khi cho cái này chạy:
PHP:
Sub GhiThietBiThiCongCanThiet()
Dim Rng As Range, sRng As Range, Cls As Range
Dim MyAdd As String
Dim Rws As Long, W As Integer

With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
End With
Sheets("May Thi Cong").Select
For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            Sheets("Diary").Cells(sRng.Row, "T").Value = Cls.Offset(, 1).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
Next Cls
End Sub
Thầy ơi, em có chạy mã code Thầy viết giúp, cái ẩn dòng thì không vấn đề gì
Nhưng có code điền dữ liệu máy móc thi công em thấy có vấn đề sau ạ!:
Ở 2 dòng em tô màu xanh (dòng 61 và 69) thì máy móc điền vào cột T ứng với công việc thi công lại không đủ ( công việc thi công tương ứng dữ liệu lấy từ sheet "May thi cong") cụ thể như sau:
- Ở dòng 61 còn thiếu "máy đầm, máy đầm cóc"
- Ở dòng 69 còn thiếu "máy cắt, máy hàn, máy trộn bê tông"
Mong Thầy giúp đỡ em ạ! Em cám ơn thầy.

Test thu.jpg
 

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,058
Được thích
15,625
Điểm
1,860
Tuổi
60
Nơi ở
An Giang
Thầy ơi, em có chạy mã code Thầy viết giúp, cái ẩn dòng thì không vấn đề gì
Nhưng có code điền dữ liệu máy móc thi công em thấy có vấn đề sau ạ!:
Ở 2 dòng em tô màu xanh (dòng 61 và 69) thì máy móc điền vào cột T ứng với công việc thi công lại không đủ ( công việc thi công tương ứng dữ liệu lấy từ sheet "May thi cong") cụ thể như sau:
- Ở dòng 61 còn thiếu "máy đầm, máy đầm cóc"
- Ở dòng 69 còn thiếu "máy cắt, máy hàn, máy trộn bê tông"
Mong Thầy giúp đỡ em ạ! Em cám ơn thầy.

View attachment 202228
Thử chạy Sub này xem sao.
PHP:
Public Sub DungCuThiCong()
Dim Dic As Object, sArr(), dArr(), tArr(), Tmp, Txt As String
Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sheets("May thi cong").Range("B2", Sheets("May thi cong").Range("B2").End(xlDown)).Resize(, 2).Value
R2 = UBound(tArr)
With Sheets("DIARY")
    sArr = .Range("I2", .Range("I60000").End(xlUp)).Value
    R1 = UBound(sArr)
    ReDim dArr(1 To R1, 1 To 1)
    For I = 1 To R1
        Dic.RemoveAll
        Tmp = Split(sArr(I, 1), ChrW(10))
        For J = LBound(Tmp) To UBound(Tmp)
            Txt = Tmp(J)
            For N = 1 To R2
                If Txt Like tArr(N, 1) & "*" Then
                    If Not Dic.Exists(tArr(N, 2)) Then
                        Dic.Item(tArr(N, 2)) = ""
                        dArr(I, 1) = dArr(I, 1) & "; " & tArr(N, 2)
                    End If
                End If
            Next N
        Next J
    Next I
    For I = 1 To R1
        If Len(dArr(I, 1)) Then
            dArr(I, 1) = Mid(dArr(I, 1), 3)
        End If
    Next I
    .Range("T2").Resize(R1) = dArr
End With
Set Dic = Nothing
End Sub
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
5,859
Được thích
9,783
Điểm
860
À ha,. . . . Nó sẽ là vầy:
PHP:
Sub GhiThietBiThiCongCanThiet()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String
 Dim Rws As Long, W As Integer, VTr As Integer                  '*          '
 
 With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
 End With
 Sheets("May Thi Cong").Select
 For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            With Sheets("Diary").Cells(sRng.Row, "T")               '|=>    '
                VTr = InStr(.Value, Cls.Offset(, 1).Value)
                If VTr < 1 Then
                    .Value = .Value & ", " & Cls.Offset(, 1).Value
                End If
            End With                                                '<=|    '
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
End Sub
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
À ha,. . . . Nó sẽ là vầy:
PHP:
Sub GhiThietBiThiCongCanThiet()
Dim Rng As Range, sRng As Range, Cls As Range
Dim MyAdd As String
Dim Rws As Long, W As Integer, VTr As Integer                  '*          '

With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
End With
Sheets("May Thi Cong").Select
For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            With Sheets("Diary").Cells(sRng.Row, "T")               '|=>    '
                VTr = InStr(.Value, Cls.Offset(, 1).Value)
                If VTr < 1 Then
                    .Value = .Value & ", " & Cls.Offset(, 1).Value
                End If
            End With                                                '<=|    '
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
Next Cls
End Sub
Hi, em cám ơn Thầy!
Bài đã được tự động gộp:

Thử chạy Sub này xem sao.
PHP:
Public Sub DungCuThiCong()
Dim Dic As Object, sArr(), dArr(), tArr(), Tmp, Txt As String
Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sheets("May thi cong").Range("B2", Sheets("May thi cong").Range("B2").End(xlDown)).Resize(, 2).Value
R2 = UBound(tArr)
With Sheets("DIARY")
    sArr = .Range("I2", .Range("I60000").End(xlUp)).Value
    R1 = UBound(sArr)
    ReDim dArr(1 To R1, 1 To 1)
    For I = 1 To R1
        Dic.RemoveAll
        Tmp = Split(sArr(I, 1), ChrW(10))
        For J = LBound(Tmp) To UBound(Tmp)
            Txt = Tmp(J)
            For N = 1 To R2
                If Txt Like tArr(N, 1) & "*" Then
                    If Not Dic.Exists(tArr(N, 2)) Then
                        Dic.Item(tArr(N, 2)) = ""
                        dArr(I, 1) = dArr(I, 1) & "; " & tArr(N, 2)
                    End If
                End If
            Next N
        Next J
    Next I
    For I = 1 To R1
        If Len(dArr(I, 1)) Then
            dArr(I, 1) = Mid(dArr(I, 1), 3)
        End If
    Next I
    .Range("T2").Resize(R1) = dArr
End With
Set Dic = Nothing
End Sub
Em cám ơn Thầy Ba Tê
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thử chạy Sub này xem sao.
PHP:
Public Sub DungCuThiCong()
Dim Dic As Object, sArr(), dArr(), tArr(), Tmp, Txt As String
Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sheets("May thi cong").Range("B2", Sheets("May thi cong").Range("B2").End(xlDown)).Resize(, 2).Value
R2 = UBound(tArr)
With Sheets("DIARY")
    sArr = .Range("I2", .Range("I60000").End(xlUp)).Value
    R1 = UBound(sArr)
    ReDim dArr(1 To R1, 1 To 1)
    For I = 1 To R1
        Dic.RemoveAll
        Tmp = Split(sArr(I, 1), ChrW(10))
        For J = LBound(Tmp) To UBound(Tmp)
            Txt = Tmp(J)
            For N = 1 To R2
                If Txt Like tArr(N, 1) & "*" Then
                    If Not Dic.Exists(tArr(N, 2)) Then
                        Dic.Item(tArr(N, 2)) = ""
                        dArr(I, 1) = dArr(I, 1) & "; " & tArr(N, 2)
                    End If
                End If
            Next N
        Next J
    Next I
    For I = 1 To R1
        If Len(dArr(I, 1)) Then
            dArr(I, 1) = Mid(dArr(I, 1), 3)
        End If
    Next I
    .Range("T2").Resize(R1) = dArr
End With
Set Dic = Nothing
End Sub
Thầy ơi bỏ dấu
Thêm 1 tham khảo:
PHP:
Sub AnDongKhiKhongCoDuLieu()
Dim Rws As Long, Dem As Integer
Dim WF As Object, Rng As Range, STT As Long

Set WF = Application.WorksheetFunction
Rws = [B2].CurrentRegion.Rows.Count
Rows("1:" & Rws).Hidden = False
Application.ScreenUpdating = False
For J = 2 To Rws
    Set Rng = Range(Cells(J, "D"), Cells(J, "Y"))
    Dem = WF.CountA(Rng)
    If Dem Then
        STT = STT + 1:              Cells(J, "A").Value = STT
    Else
        Rows(J & ":" & J).Hidden = True
    End If
Next J
Application.ScreenUpdating = True
MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
End Sub
Thầy ơi! Em nhờ Thầy giúp em thêm chút xíu nữa cho hoàn thiện, Thầy giúp em ẩn những cột với điều kiện " tất cả các cột từ dòng thứ 2 trở xuống mà không có dữ liệu đều bị ẩn đi, xét trong vùng làm việc từ cột A đến cột Y.
E cám ơn Thầy ạ!
Bài đã được tự động gộp:

Hi, em cám ơn Thầy!
Bài đã được tự động gộp:


Em cám ơn Thầy Ba Tê
Thầy ơi! Em nhờ Thầy giúp em thêm chút xíu nữa cho hoàn thiện, Thầy giúp em ẩn những cột với điều kiện " tất cả các cột từ dòng thứ 2 trở xuống mà không có dữ liệu đều bị ẩn đi, xét trong vùng làm việc từ cột A đến cột Y.
E cám ơn Thầy ạ!
 

File đính kèm

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Thử chạy Sub này xem sao.
PHP:
Public Sub DungCuThiCong()
Dim Dic As Object, sArr(), dArr(), tArr(), Tmp, Txt As String
Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sheets("May thi cong").Range("B2", Sheets("May thi cong").Range("B2").End(xlDown)).Resize(, 2).Value
R2 = UBound(tArr)
With Sheets("DIARY")
    sArr = .Range("I2", .Range("I60000").End(xlUp)).Value
    R1 = UBound(sArr)
    ReDim dArr(1 To R1, 1 To 1)
    For I = 1 To R1
        Dic.RemoveAll
        Tmp = Split(sArr(I, 1), ChrW(10))
        For J = LBound(Tmp) To UBound(Tmp)
            Txt = Tmp(J)
            For N = 1 To R2
                If Txt Like tArr(N, 1) & "*" Then
                    If Not Dic.Exists(tArr(N, 2)) Then
                        Dic.Item(tArr(N, 2)) = ""
                        dArr(I, 1) = dArr(I, 1) & "; " & tArr(N, 2)
                    End If
                End If
            Next N
        Next J
    Next I
    For I = 1 To R1
        If Len(dArr(I, 1)) Then
            dArr(I, 1) = Mid(dArr(I, 1), 3)
        End If
    Next I
    .Range("T2").Resize(R1) = dArr
End With
Set Dic = Nothing
End Sub
Thầy ạ! Thầy cho em hỏi thêm chút xíu ạ!
giờ em có nhiều sheet và các
Thử chạy Sub này xem sao.
PHP:
Public Sub DungCuThiCong()
Dim Dic As Object, sArr(), dArr(), tArr(), Tmp, Txt As String
Dim I As Long, J As Long, N As Long, R1 As Long, R2 As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Sheets("May thi cong").Range("B2", Sheets("May thi cong").Range("B2").End(xlDown)).Resize(, 2).Value
R2 = UBound(tArr)
With Sheets("DIARY")
    sArr = .Range("I2", .Range("I60000").End(xlUp)).Value
    R1 = UBound(sArr)
    ReDim dArr(1 To R1, 1 To 1)
    For I = 1 To R1
        Dic.RemoveAll
        Tmp = Split(sArr(I, 1), ChrW(10))
        For J = LBound(Tmp) To UBound(Tmp)
            Txt = Tmp(J)
            For N = 1 To R2
                If Txt Like tArr(N, 1) & "*" Then
                    If Not Dic.Exists(tArr(N, 2)) Then
                        Dic.Item(tArr(N, 2)) = ""
                        dArr(I, 1) = dArr(I, 1) & "; " & tArr(N, 2)
                    End If
                End If
            Next N
        Next J
    Next I
    For I = 1 To R1
        If Len(dArr(I, 1)) Then
            dArr(I, 1) = Mid(dArr(I, 1), 3)
        End If
    Next I
    .Range("T2").Resize(R1) = dArr
End With
Set Dic = Nothing
End Sub
Thưa Thầy, Thầy cho em hỏi chút xíu ạ!
Thầy giúp em điền máy móc ở sheet "May thi cong" để điền tương ứng vào cột máy móc (Cột T) của các công việc (Cột I) ở các sheet còn lại (nha de xe, san be tong, ......)
* Các loại máy móc được tổng hợp vào các ngày tương ứng với công việc nào đó ở cột T được ngăn cách bởi dấu "," và dấu cách, các loại máy khi tổng hợp trùng nhau chỉ tính một lần.
* Mỗi gạch "-" ở trong ô của "cột I" ứng với một công việc thi công và ứng với một loại máy khi so sánh với sheet "May thi cong"
Thầy giúp em ạ! Em cám ơn Thầymay thi cong.jpg
 

File đính kèm

Lần chỉnh sửa cuối:

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia ngày
10 Tháng ba 2018
Bài viết
665
Được thích
1,399
Điểm
360
Nơi ở
Cái Bang
Thầy ạ! Thầy cho em hỏi thêm chút xíu ạ!
giờ em có nhiều sheet và các

Thưa Thầy, Thầy cho em hỏi chút xíu ạ!
Em có nhiều sheet mà không phải là 1 sheet như sheet "DIARY"
Giờ em muốn lấy máy móc điền vào tất cả các sheet "May thi cong" để điền tương ứng các công việc ở các sheet còn lại (nha de xe, san be tong, ......)
Thầy giúp em ạ! Em cám ơn Thầy
Hỏi mà không có file đính kèm Thầy lại tửi cho bi giờ. Qua giờ chưa tâm sự với bạn gì kia à
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
À ha,. . . . Nó sẽ là vầy:
PHP:
Sub GhiThietBiThiCongCanThiet()
Dim Rng As Range, sRng As Range, Cls As Range
Dim MyAdd As String
Dim Rws As Long, W As Integer, VTr As Integer                  '*          '

With Sheets("Diary").[I1]
    Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(Rws)
End With
Sheets("May Thi Cong").Select
For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        W = W + 1:                  If W = 12 Then W = 0
        Do
            sRng.Interior.ColorIndex = 34 + W
            With Sheets("Diary").Cells(sRng.Row, "T")               '|=>    '
                VTr = InStr(.Value, Cls.Offset(, 1).Value)
                If VTr < 1 Then
                    .Value = .Value & ", " & Cls.Offset(, 1).Value
                End If
            End With                                                '<=|    '
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
Next Cls
End Sub
Thầy giúp em vấn đề bài #14 em vừa đăng ạ! e cám ơn Thầy!
Bài đã được tự động gộp:

Hỏi mà không có file đính kèm Thầy lại tửi cho bi giờ. Qua giờ chưa tâm sự với bạn gì kia à
Có mà chị ơi! có file đính kèm ạ! Chị giúp em mới nhé!
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Lần chỉnh sửa cuối:

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
5,859
Được thích
9,783
Điểm
860
Các tên trang tính nên có khuôn fép thì tiện trong khi xài VBA; Như:

9_Nha de xe
9_San
13Be tong
. . . .
Các con số 9 hay 13 là những cột tương ứng cần lây dữ liệu của trang (tính)
 

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
285
Được thích
28
Điểm
185
Tuổi
32
Các tên trang tính nên có khuôn fép thì tiện trong khi xài VBA; Như:

9_Nha de xe
9_San
13Be tong
. . . .
Các con số 9 hay 13 là những cột tương ứng cần lây dữ liệu của trang (tính)
Đối chiếu dữ liệu Thi công (Cột I) của các sheet (Nha de xe, san be tong, Ranh nuoc, Nha hieu bo, Cot co) với Sheet "May thi cong" để điền tên máy thi công vào ô trong từng dòng tương ứng với từng ngày của cột T trong các sheet (Nha de xe, san be tong, Ranh nuoc, Nha hieu bo, Cot co)
Như Thầy cho ý kiến ở bài #19 thì các sheet như (Nha de xe, san be tong, Ranh nuoc, Nha hieu bo, Cot co) đều có cột cần lấy dữ liệu từ cột C của sheet "May thi cong" là cột thứ 20 (Cột T), và tên các trang tính cần được điền dữ liệu máy thi công em sẽ đổi lại như sau:
20_Nha de xe
20_San
20_Be tong
.................
Em hiểu vậy có đúng không ạ!
Em cảm ơn Thầy!
 
Top Bottom