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ả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
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
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
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
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, HM5Nế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ả
Dạ em cám ơn Thầy, chúc Thầy buổi tối vui vẻ!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ì ra em ấy đã bị lạc đề . hahaAnh ơ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ầ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 ạ!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
E cám ơn Chị ạ!
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
Nên theo khuôn fép, theo qui luậ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 ạ!
Vâng, em cám ơn ạ!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!
Dạ, em cám ơn Thầy!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
Thưa Thầy, Thầy cho em hỏi chút xíu ạ!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!
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2