Mong các bác giúp em dùng hàm dò tìm dữ liệu

[xtgt2501]

Mong các bác giúp em dùng hàm đưa dữ liệu cột " Thành tiền" trong sheet PTDG sang sheet DGCT và DGTH tương ứng với các cột (Vật liệu chính A = (VLC ); Vật liệu phụ B = (VLP); Nhân công C = NC; Máy thi công D = MAY )
( Giá trị em tô màu đỏ trong file đính kèm)
Cảm ơn các bác!

 

[PacificPR]

Mong các bác giúp em dùng hàm đưa dữ liệu cột " Thành tiền" trong sheet PTDG sang sheet DGCT và DGTH tương ứng với các cột (Vật liệu chính A = (VLC ); Vật liệu phụ B = (VLP); Nhân công C = NC; Máy thi công D = MAY )
( Giá trị em tô màu đỏ trong file đính kèm)
Cảm ơn các bác!

Chắc cái này phải làm bằng VBA bạn à

 

[xtgt2501]

Bạn ơi bạn làm giúp mình nhé! Minh đang rất cần cái này.

 

[Ba Tê]

Mong các bác giúp em dùng hàm đưa dữ liệu cột " Thành tiền" trong sheet PTDG sang sheet DGCT và DGTH tương ứng với các cột (Vật liệu chính A = (VLC ); Vật liệu phụ B = (VLP); Nhân công C = NC; Máy thi công D = MAY )
( Giá trị em tô màu đỏ trong file đính kèm)
Cảm ơn các bác!

Chỉnh lại tiêu đề cột cần lấy số liệu phải giống nội dung cần lấy trong cột D sheet "PTDG".

 

[xtgt2501]

Cảm ơn @Ba Tê nhé!
Bạn cho mình hỏi thêm chút : mình muốn thêm nhiều mục nữa thì VBA vẫn chạy cho tất cả chứ?

 

[Ba Tê]

Cảm ơn @Ba Tê nhé!
Bạn cho mình hỏi thêm chút : mình muốn thêm nhiều mục nữa thì VBA vẫn chạy cho tất cả chứ?

Yêu cầu bao nhiêu thì viết code cho bấy nhiêu, đâu thể muốn "bao la" là code nó "bao lô".

 

[xtgt2501]

ok. Cảm ơn @Ba Tê nhiều nhé!

 

[Hoang2013]

Trâu chậm uống nước trong:

Sub ChuyenDonGia()
 Dim Rws As Long, Col As Byte
 Dim MaH As String, Dz As String
 Const Alf As String = "C) P) NC AY"
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Arr()
 
 Sheets("PTDG").Select
 Rws = [d6].CurrentRegion.Rows.Count + 9
 ReDim Arr(1 To 1, 1 To 5)
 For j = 6 To Rws   'Duyet Tù Dòng Thú 6'
    With Cells(j, "B")
        If .Value <> "" Then
            If j = 6 Then
            ElseIf j > 6 Then
                Set Sh = ThisWorkbook.Worksheets("DGCT")
                Set Rng = Sh.[B4].Resize(Rws)
                Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
                If Not sRng Is Nothing Then
                    sRng.Offset(, 4).Resize(, 4).Value = Arr()
                End If
               
                Set Sh = ThisWorkbook.Worksheets("DGTH")
                Set Rng = Sh.[B4].Resize(Rws)
                Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
                If Not sRng Is Nothing Then
                    sRng.Offset(, 4).Value = Arr(1, 5)
                End If
            End If
            MaH = Cells(j, "B").Value
        ElseIf .Value = "" And .Offset(, 1).Value = "" Then
            Dz = Right(RTrim$(.Offset(, 2).Value), 2)
            If InStr(Alf, Dz) And Dz <> "" Then
                Col = Switch(Dz = "C)", 1, Dz = "P)", 2, Dz = "NC", 3, Dz = "AY", 4)
                Arr(1, Col) = Cells(j, "H").Value
            Else
                Dz = Right(RTrim$(.Offset(, 2).Value), 3)
                If Left(Dz, 1) = "h" And Right(Dz, 1) = "p" Then
                    Arr(1, 5) = Cells(j, "H").Value
                End If
            End If
        End If
    End With
    Set Sh = ThisWorkbook.Worksheets("DGCT")
    Set Rng = Sh.[B4].Resize(Rws)
    Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        sRng.Offset(, 4).Resize(, 4).Value = Arr()
    End If
    Set Sh = ThisWorkbook.Worksheets("DGTH")
    Set Rng = Sh.[B4].Resize(Rws)
    Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        sRng.Offset(, 4).Value = Arr(1, 5)
    End If
 Next j
End Sub

 

[xtgt2501]

Trâu chậm uống nước trong:

Sub ChuyenDonGia()
 Dim Rws As Long, Col As Byte
 Dim MaH As String, Dz As String
 Const Alf As String = "C) P) NC AY"
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Arr()
 
 Sheets("PTDG").Select
 Rws = [d6].CurrentRegion.Rows.Count + 9
 ReDim Arr(1 To 1, 1 To 5)
 For j = 6 To Rws   'Duyet Tù Dòng Thú 6'
    With Cells(j, "B")
        If .Value <> "" Then
            If j = 6 Then
            ElseIf j > 6 Then
                Set Sh = ThisWorkbook.Worksheets("DGCT")
                Set Rng = Sh.[B4].Resize(Rws)
                Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
                If Not sRng Is Nothing Then
                    sRng.Offset(, 4).Resize(, 4).Value = Arr()
                End If
              
                Set Sh = ThisWorkbook.Worksheets("DGTH")
                Set Rng = Sh.[B4].Resize(Rws)
                Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
                If Not sRng Is Nothing Then
                    sRng.Offset(, 4).Value = Arr(1, 5)
                End If
            End If
            MaH = Cells(j, "B").Value
        ElseIf .Value = "" And .Offset(, 1).Value = "" Then
            Dz = Right(RTrim$(.Offset(, 2).Value), 2)
            If InStr(Alf, Dz) And Dz <> "" Then
                Col = Switch(Dz = "C)", 1, Dz = "P)", 2, Dz = "NC", 3, Dz = "AY", 4)
                Arr(1, Col) = Cells(j, "H").Value
            Else
                Dz = Right(RTrim$(.Offset(, 2).Value), 3)
                If Left(Dz, 1) = "h" And Right(Dz, 1) = "p" Then
                    Arr(1, 5) = Cells(j, "H").Value
                End If
            End If
        End If
    End With
    Set Sh = ThisWorkbook.Worksheets("DGCT")
    Set Rng = Sh.[B4].Resize(Rws)
    Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        sRng.Offset(, 4).Resize(, 4).Value = Arr()
    End If
    Set Sh = ThisWorkbook.Worksheets("DGTH")
    Set Rng = Sh.[B4].Resize(Rws)
    Set sRng = Rng.Find(MaH, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        sRng.Offset(, 4).Value = Arr(1, 5)
    End If
 Next j
End Sub

Cảm ơn anh Hoang2013 nhiều nhé!