Xin giúp đỡ code lấy giữ liệu từ Sheet tổng hợp để điền dữ liễu vào các ngày tương ứng trong sheet khác

dangky47h · 27/8/18

Em nhờ các anh, chị giúp đỡ em code lấy dữ liệu từ sheet "Tong" để điền vào các ngày tương ứng trong các sheet (HM1 đến HM5)
Em mong được sự giúp đỡ.

LamNA · 27/8/18

dangky47h đã viết:
Em nhờ các anh, chị giúp đỡ em code lấy dữ liệu từ sheet "Tong" để điền vào các ngày tương ứng trong các sheet (HM1 đến HM5)
Em mong được sự giúp đỡ.View attachment 202662

Nếu các ngày không trùng nhau thì bạn dùng file này, copy ngày tháng vào cột H của các sheet HM1 đến HM5 và xem kết quả

♫ђöล♥ßล†♥†µ♫ · 27/8/18

dangky47h đã viết:
Em nhờ các anh, chị giúp đỡ em code lấy dữ liệu từ sheet "Tong" để điền vào các ngày tương ứng trong các sheet (HM1 đến HM5)
Em mong được sự giúp đỡ.View attachment 202662

PHP:

Sub UpDateData()
    Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, R As Long
    Dim WsData As Worksheet, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set WsData = Sheets("Tong")
With WsData
    sArr = .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Resize(, 2).Value
End With
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = I
Next I
For Each Ws In Worksheets
    If Ws.Name <> WsData.Name Then
        With Ws
            tArr = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Value
            ReDim dArr(1 To UBound(sArr), 1 To 1)
            For I = 1 To UBound(tArr)
                R = Dic.Item(tArr(I, 1))
                If R Then dArr(I, 1) = sArr(R, 2)
            Next I
            .Range("R2", .Range("R" & Rows.Count).End(xlUp)).ClearContents
            .Range("R2").Resize(I - 1) = dArr
        End With
    End If
Next
MsgBox "Da Cap nhat xong.", , "Thong bao"
Set Dic = Nothing
End Sub

SA_DQ · 27/8/18

Một cách thô thiển đây & xin mời

PHP:

Sub TuTrang_Tong()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim Rws As Long
 
 With Sheets("Tong").[H2]
   ' Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(9999)
 End With
 For Each Sh In ThisWorkbook.Worksheets
    If Left(Sh.Name, 2) = "HM" Then
        For Each Cls In Sh.Range(Sh.[B2], Sh.[B2].End(xlDown))
            Set sRng = Rng.Find(Format(Cls.Value, "MM/DD/yyyy"), , xlValues, xlWhole)
            If sRng Is Nothing Then 
            Else
                Sh.Cells(Cls.Row, "R").Value = sRng.Offset(, 1).Value
            End If
        Next Cls
    End If
 Next Sh
End Sub

dangky47h · 27/8/18

LamNA đã viết:
Nếu các ngày không trùng nhau thì bạn dùng file này, copy ngày tháng vào cột H của các sheet HM1 đến HM5 và xem kết quả

Anh ơi ý em là các ngày ở các sheet có thể trùng hay không trùng nhưng đều lấy từ sheet "Tong" để điền vào các ngày tươn ứng trong sheet HM1, MH2, MH3, MH4, HM5

dangky47h · 27/8/18

SA_DQ đã viết:

Một cách thô thiển đây & xin mời

PHP:

Sub TuTrang_Tong()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long

With Sheets("Tong").[H2]
   ' Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(9999)
End With
For Each Sh In ThisWorkbook.Worksheets
    If Left(Sh.Name, 2) = "HM" Then
        For Each Cls In Sh.Range(Sh.[B2], Sh.[B2].End(xlDown))
            Set sRng = Rng.Find(Format(Cls.Value, "MM/DD/yyyy"), , xlValues, xlWhole)
            If sRng Is Nothing Then
            Else
                Sh.Cells(Cls.Row, "R").Value = sRng.Offset(, 1).Value
            End If
        Next Cls
    End If
Next Sh
End Sub

Dạ em cám ơn Thầy, chúc Thầy buổi tối vui vẻ!

LamNA · 27/8/18

dangky47h đã viết:
Anh ơi ý em là các ngày ở các sheet có thể trùng hay không trùng nhưng đều lấy từ sheet "Tong" để điền vào các ngày tươn ứng trong sheet HM1, MH2, MH3, MH4, HM5

À thì ra em ấy đã bị lạc đề . haha

befaint · 28/8/18

dangky47h · 28/8/18

befaint đã viết:
.

Dạ em cám ơn Thầy ạ!

dangky47h · 28/8/18

SA_DQ đã viết:

Một cách thô thiển đây & xin mời

PHP:

Sub TuTrang_Tong()
Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
Dim Rws As Long

With Sheets("Tong").[H2]
   ' Rws = .CurrentRegion.Rows.Count
    Set Rng = .Resize(9999)
End With
For Each Sh In ThisWorkbook.Worksheets
    If Left(Sh.Name, 2) = "HM" Then
        For Each Cls In Sh.Range(Sh.[B2], Sh.[B2].End(xlDown))
            Set sRng = Rng.Find(Format(Cls.Value, "MM/DD/yyyy"), , xlValues, xlWhole)
            If sRng Is Nothing Then
            Else
                Sh.Cells(Cls.Row, "R").Value = sRng.Offset(, 1).Value
            End If
        Next Cls
    End If
Next Sh
End Sub

Thầy ơi, em hỏi chút ạ! e thay đổi tên sheet cần điền dữ liệu không phải theo quy luật là HM1, MH2, HM3, HM4, HM5 mà là tên bất kỳ nào đó ở mỗi sheet không theo quy luật "HM" thì sửa lại code như thế nào ạ!
Em ví dụ như hình dưới:

Bài đã được tự động gộp: 28/8/18

♫ђöล♥ßล†♥†µ♫ đã viết:

PHP:

Sub UpDateData()
    Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, R As Long
    Dim WsData As Worksheet, Ws As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set WsData = Sheets("Tong")
With WsData
    sArr = .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Resize(, 2).Value
End With
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = I
Next I
For Each Ws In Worksheets
    If Ws.Name <> WsData.Name Then
        With Ws
            tArr = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Value
            ReDim dArr(1 To UBound(sArr), 1 To 1)
            For I = 1 To UBound(tArr)
                R = Dic.Item(tArr(I, 1))
                If R Then dArr(I, 1) = sArr(R, 2)
            Next I
            .Range("R2", .Range("R" & Rows.Count).End(xlUp)).ClearContents
            .Range("R2").Resize(I - 1) = dArr
        End With
    End If
Next
MsgBox "Da Cap nhat xong.", , "Thong bao"
Set Dic = Nothing
End Sub

E cám ơn Chị ạ!

SA_DQ · 28/8/18

e thay đổi tên sheet cần điền dữ liệu không phải theo quy luật là HM1, MH2, HM3, HM4, HM5 mà là tên bất kỳ nào đó ở mỗi sheet không theo quy luật "HM" thì sửa lại code như thế nào ạ!

Nên theo khuôn fép, theo qui luật;
Còn bằng khác đi thì fải trang bị thêm kiến thức thôi:
Đưa hết tên các trang tính cần thiết vô mảng (đã khai báo trước)
Sau đó duyệt theo mảng chứa các tên trang này 1 cách lần lượt. & Bạn tự tiếp tục xem sao!

dangky47h · 28/8/18

SA_DQ đã viết:
Nên theo khuôn fép, theo qui luật;
Còn bằng khác đi thì fải trang bị thêm kiến thức thôi:
Đưa hết tên các trang tính cần thiết vô mảng (đã khai báo trước)
Sau đó duyệt theo mảng chứa các tên trang này 1 cách lần lượt. & Bạn tự tiếp tục xem sao!

Vâng, em cám ơn ạ!

ndu96081631 · 28/8/18

Bài này có thể dùng Advanced Filter với 1 vòng lập. Vùng điều kiện chính là cột B ở các sheets con
Ai đó thử xem
-------------
Chỉ e rằng dữ liệu thật của tác giả lại không giống thế thì thua

dangky47h · 28/8/18

ndu96081631 đã viết:
Bài này có thể dùng Advanced Filter với 1 vòng lập. Vùng điều kiện chính là cột B ở các sheets con
Ai đó thử xem
-------------
Chỉ e rằng dữ liệu thật của tác giả lại không giống thế thì thua

Dạ, em cám ơn Thầy!

dangky47h · 28/8/18

SA_DQ đã viết:
Nên theo khuôn fép, theo qui luật;
Còn bằng khác đi thì fải trang bị thêm kiến thức thôi:
Đưa hết tên các trang tính cần thiết vô mảng (đã khai báo trước)
Sau đó duyệt theo mảng chứa các tên trang này 1 cách lần lượt. & Bạn tự tiếp tục xem sao!

Thưa Thầy, Thầy cho em hỏi chút xíu ạ!
Giờ em muốn lấy máy móc ở sheet "May thi cong" để điền tương ứng vào các ngày của nội dung công việc ở "cột T" của các sheet còn lại (nha de xe, san be tong, ......)
Các máy móc được điền vào ô từng ngày ở cột T được ngăn bởi dấu "," và dấu cách
Thầy giúp em ạ! Em cám ơn Thầy

dangky47h · 28/8/18

befaint đã viết:
.

Thầy ạ! em nhờ Thầy xem giúp em bài #15
Em cám ơn Thầy!

Xin giúp đỡ code lấy giữ liệu từ Sheet tổng hợp để điền dữ liễu vào các ngày tương ứng trong sheet khác

Thành viên thường trực

File đính kèm

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

/(hông là gì!

Thành viên thường trực

Thành viên thường trực

Thành viên tích cực

|||||||||||||

File đính kèm

Thành viên thường trực

Thành viên thường trực

File đính kèm

/(hông là gì!

Thành viên thường trực

Huyền thoại GPE

Thành viên thường trực

Thành viên thường trực

File đính kèm

Thành viên thường trực

Facebook

Group