Nhờ các bạn chuyển giúp dữ liệu

[quyettam]

Mình cần chuyển số liệu: Vật liệu; nhân công; máy từ cột dọc sang hàng ngang theo mã định mức AB…; AF…; nhưng không tự động được nhờ các bạn trên diễn đàn giúp. Mình có file nhưng làm thủ công quá.
Xin cảm ơn

 

[VetMini]

Lười làm thủ công thì dùng chức năng tìm kiếm



Tìm những người có viết bài liên quan đến Power Query. Gọi thẳng tên người ta mà nhờ giúp.

Nếu tìm kiếm cũngn cho là thủ công thì chịu đợi. Hy vọng có người lên làm tự động cho. Gì chứ diễn đàn này rất lắm người siêng.

 

[HUONGHCKT]

Mình cần chuyển số liệu: Vật liệu; nhân công; máy từ cột dọc sang hàng ngang theo mã định mức AB…; AF…; nhưng không tự động được nhờ các bạn trên diễn đàn giúp. Mình có file nhưng làm thủ công quá.
Xin cảm ơn

Góp vui một chút. Không biết có đúng ý không-làm bằng VBa nhưng không hiểu sao mà chạy quá chậm. Kết quả trả về đang để dồn vào một chỗ,...

 

[Phuocam]

Rút gọn lại một chút:

Sub DON_GIA()
Dim Arr(), KQ()
Dim i&, j&, k&, Lr&
With Sheet1
Lr = .Range("C" & .Rows.Count).End(3).Row
Arr = .Range("B5:G" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> Empty Then
        t = t + 1
        KQ(t, 1) = t
        KQ(t, 2) = Arr(i, 1)
    ElseIf Trim(Arr(i, 2)) Like "A-*" Then
        KQ(t, 3) = Arr(i, 6)
    ElseIf Trim(Arr(i, 2)) Like "B-*" Then
        KQ(t, 4) = Arr(i, 6)
    ElseIf Trim(Arr(i, 2)) Like "C-*" Then
        KQ(t, 5) = Arr(i, 6)
    End If
Next i
End With
If t Then
    Sheet2.UsedRange.Offset(1).ClearContents
    Sheet2.Cells(2, 1).Resize(t, 5) = KQ
End If
End Sub

 

[HUONGHCKT]

Rút gọn lại một chút:

Sub DON_GIA()
Dim Arr(), KQ()
Dim i&, j&, k&, Lr&
With Sheet1
Lr = .Range("C" & .Rows.Count).End(3).Row
Arr = .Range("B5:G" & Lr).Value
ReDim KQ(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
    If Arr(i, 1) <> Empty Then
        t = t + 1
        KQ(t, 1) = t
        KQ(t, 2) = Arr(i, 1)
    ElseIf Trim(Arr(i, 2)) Like "A-*" Then
        KQ(t, 3) = Arr(i, 6)
    ElseIf Trim(Arr(i, 2)) Like "B-*" Then
        KQ(t, 4) = Arr(i, 6)
    ElseIf Trim(Arr(i, 2)) Like "C-*" Then
        KQ(t, 5) = Arr(i, 6)
    End If
Next i
End With
If t Then
    Sheet2.UsedRange.Offset(1).ClearContents
    Sheet2.Cells(2, 1).Resize(t, 5) = KQ
End If
End Sub

cảm on anh đã chỉ giáo. lúc đầu tôi cũng dùng vòng lặp for i =1 to.... và if Arr(i,2)=A ....KQ(i,3)=Arr(i,6) để ghi kết quả vào dòng ngang với dòng mã nhưng không hiểu tại sao thử mãi, thay đổi các kiểu mà không ra kết quả như ý. buộc lòng phải dùng J=.cells(i,2).end(xlDown).row và vòng lặp For k=i to J thì ra kết quả.
Thật là ngưỡng mộ tầm cỡ chuyên gia VBA.

 

[VetMini]

If Arr(i, 1) <> Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 1)
ElseIf Trim(Arr(i, 2)) Like "A-*" Then
KQ(t, 3) = Arr(i, 6)
ElseIf Trim(Arr(i, 2)) Like "B-*" Then
KQ(t, 4) = Arr(i, 6)
ElseIf Trim(Arr(i, 2)) Like "C-*" Then
KQ(t, 5) = Arr(i, 6)
End If

Khi xét một trị mà dùng ElseIf thì phải tính trị ấy nhiều lần. Tuy phép tính cũng nhanh nhưng làm như vậy thì không "đẹp" lắm. (đoạn code trên 3 lần ElseIf Trim(Arr(i, 2)) thì có nghĩa là trung bình tính biểu thức ấy 1,5 lần)
Mặt khác, nếu về sau điều kiện thay đổi một chút thì phải chỉnh 3 chỗ.

If Arr(i, 1) <> Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 1)
Else
Select Case Left(Trim(Arr(i, 2)),2) ' chỉ tính biểu thức một lần
Case "A-*"
KQ(t, 3) = Arr(i, 6)
Case "B-"
KQ(t, 4) = Arr(i, 6)
Case "C-"
KQ(t, 5) = Arr(i, 6)
End Select
End If

Ngược lại, ElseIf sẽ hơn hẳn Select nếu xét nhiều trường hợp, nhiều trị.

 

[quyettam]

Khi xét một trị mà dùng ElseIf thì phải tính trị ấy nhiều lần. Tuy phép tính cũng nhanh nhưng làm như vậy thì không "đẹp" lắm. (đoạn code trên 3 lần ElseIf Trim(Arr(i, 2)) thì có nghĩa là trung bình tính biểu thức ấy 1,5 lần)
Mặt khác, nếu về sau điều kiện thay đổi một chút thì phải chỉnh 3 chỗ.

If Arr(i, 1) <> Empty Then
t = t + 1
KQ(t, 1) = t
KQ(t, 2) = Arr(i, 1)
Else
Select Case Left(Trim(Arr(i, 2)),2) ' chỉ tính biểu thức một lần
Case "A-*"
KQ(t, 3) = Arr(i, 6)
Case "B-"
KQ(t, 4) = Arr(i, 6)
Case "C-"
KQ(t, 5) = Arr(i, 6)
End Select
End If

Ngược lại, ElseIf sẽ hơn hẳn Select nếu xét nhiều trường hợp, nhiều trị.

Cảm ơn các bạn nhiều, nhưng nhờ các bạn giúp thêm bước.
1. Mình không thấy số liệu cột vật liệu.
2. Nhờ hướng dẫn sơ bộ làm sao để mình có thể copy sang file khác.