[Help]: Xây dựng hàm tự động điền data từ 2 worksheet khác bị lỗi, các bác xem giúp e (1 người xem)

[thaihau2004]

Chào các anh chị em gpexel,

Hiện mình đang viết 1 file macro nhỏ nhỏ để giúp tự động kiểm tra dữ liệu. Dữ liệu sẽ đc lấy từ sheet Input1 và Input2, khi chạy macro thì dữ liệu sẽ dc điền vào sheet Output.
Mình có up code mình viết, sheet Output kết quả và sheet OutPut_mongmuon (mình muốn kết quả ra như vậy mà hẻm dc ).

Bài toán:
- 1 material code trong sheet Input1 có thể có 1 hoặc 2 dòng dữ liệu (ứng với Class type ZRG, ZVN sẽ có các số Object khác nhau), hên xui. Các Object này cũng sẽ xuất hiện bên sheet Input2.
Bên sheet Input2, các Object thuộc cùng 1 material code (check bên sheet Input1) sẽ dc xuất ra trên 1 dòng trong Output.

Mình ko đc thay đổi/insert dòng/cột của Input1/Input2/Output nhé.

Không hiểu sao sheet Output mình viết, dòng số 3,dữ liệu ở cột F,G,H nó nhảy xuống dòng 4 nằm, . Kết quả đùng phải là như bên sheet Output_mongmuon kìa ;(

Các bác rảnh coi giúp giùm em với, em mới viết nên còn hơi gà.

Cám ơn các bác/ anh/ chị/em nhiều lắm!

 

[AutoReply]

nếu chịu phế hết võ công trong file đó thì xài code này

Public Sub hello()
Dim arrS1, arrS2, r As Long, dic As Object, indez, dArr(1 To 10000, 1 To 8), k As Long, tmp


arrS1 = Sheet1.Range("A2:D" & Sheet1.[A65000].End(xlUp).Row).Value2
arrS2 = Sheet2.Range("A2:D" & Sheet2.[A65000].End(xlUp).Row).Value2
Set dic = CreateObject("scripting.dictionary")
For r = 1 To UBound(arrS1) Step 1
    dic(arrS1(r, 4) & ";" & arrS1(r, 2)) = arrS1(r, 3)
    dic(arrS1(r, 3)) = 0
Next


For r = 1 To UBound(arrS2) Step 1
    If dic.exists(arrS2(r, 1) & ";" & arrS2(r, 3)) Then
        tmp = dic(arrS2(r, 1) & ";" & arrS2(r, 3))
        If dic(tmp) = 0 Then
            k = k + 1
            dic(tmp) = k
            dArr(k, 1) = tmp
        End If
        
        indez = Application.Match(arrS2(r, 2), Sheet3.Range("B1:H1"), 0)
        If TypeName(indez) <> "Error" Then
            dArr(dic(tmp), indez + 1) = arrS2(r, 4)
        End If
    End If
Next
Sheet3.Range("A2:H10000").ClearContents
If k > 0 Then Sheet3.Range("A2").Resize(k, 8).Value = dArr
End Sub

 

[thaihau2004]

Hi, quá hay luôn! Mình đã thử chạy đoạn code này, chạy ngon lành cành đào! Mà ko có hiểu đoạn code lắm . Bạn có thể giải thích rõ hơn ko? Vì sheet Input2 thực sự của mình ứng với mỗi Object number sẽ có nhiều dòng data hơn. Và sheet Ouput thì thứ tự các cột sẽ ko theo như thứ tự bên Input2 mà theo 1 thứ tự khác. Tối qua mình xóa bớt để gữi cho mọi người dễ hình dung á.

File đầy đủ thực sự mình up lại ở đây nhé.

Cám ơn bạn rất nhiều!

 

[hcminh2016]

Hi, quá hay luôn! Mình đã thử chạy đoạn code này, chạy ngon lành cành đào! Mà ko có hiểu đoạn code lắm . Bạn có thể giải thích rõ hơn ko? Vì sheet Input2 thực sự của mình ứng với mỗi Object number sẽ có nhiều dòng data hơn. Và sheet Ouput thì thứ tự các cột sẽ ko theo như thứ tự bên Input2 mà theo 1 thứ tự khác. Tối qua mình xóa bớt để gữi cho mọi người dễ hình dung á.

File đầy đủ thực sự mình up lại ở đây nhé.

Cám ơn bạn rất nhiều!

#1 của bạn đã có câu trả lời tại #2. Nhưng đọc tới #3 của bạn thì tôi chợt nghĩ giống như Kiểu làm đường tại các thành phố của Việt Nam

1. Làm xong đợt 1... Được thời gian
2. Đập, bổ sung ống cống...đường dây này nọ... Xong được thời gian
3. Đập, bổ nói rộng,... Được thời gian...
4. Đập,... làm lại...

Đó là chưa kê tới chất lượng công trình...Nếu dỡm dỡm là còn đập nhiều lần nữa...
------------------------------
P/s: và tôi không hi vọng người #2 sẽ làm giúp cho bạn lần nữa đâu. Vì làm như vậy lãng phí tài nguyên "đất nướ", hao tiền "thuế" của dân lắm...chỉ có lợi ích nhóm mà thôi!

 

[thaihau2004]

À, vấn đề ở đây là mình nhờ các bạn giải thích code, mình hiểu sẽ tự làm tiếp. Chứ ko làm lại file khác, chỉ up file lên để tham khảo nếu ko hiểu ý mình thôi.

Lí do mình rút ngắn file lại, như trên đã nói là do nhiều dòng/cột quá mình thấy rối, sợ các bạn rối theo . AW, sẽ rút kinh nghiệm cho những lần sau!

Chúc ace gpexel ngày đầu tuần vui vẻ!

 

[hcminh2016]

À, vấn đề ở đây là mình nhờ các bạn giải thích code, mình hiểu sẽ tự làm tiếp. Chứ ko làm lại file khác, chỉ up file lên để tham khảo nếu ko hiểu ý mình thôi.

Lí do mình rút ngắn file lại, như trên đã nói là do nhiều dòng/cột quá mình thấy rối, sợ các bạn rối theo . AW, sẽ rút kinh nghiệm cho những lần sau!

Chúc ace gpexel ngày đầu tuần vui vẻ!

Public Sub hello()
Dim arrS1, arrS2, r As Long, dic As Object, indez, dArr(1 To 10000, 1 To 22), k As Long, tmp
    arrS1 = Sheet1.Range("A2:D" & Sheet1.[A65000].End(xlUp).Row).Value2
    arrS2 = Sheet2.Range("A2:D" & Sheet2.[A65000].End(xlUp).Row).Value2
    Set dic = CreateObject("scripting.dictionary")
    For r = 1 To UBound(arrS1) Step 1
        dic(arrS1(r, 4) & ";" & arrS1(r, 2)) = arrS1(r, 3)
        dic(arrS1(r, 3)) = 0
    Next
    For r = 1 To UBound(arrS2) Step 1
        If dic.exists(arrS2(r, 1) & ";" & arrS2(r, 3)) Then
            tmp = dic(arrS2(r, 1) & ";" & arrS2(r, 3))
            If dic(tmp) = 0 Then
                k = k + 1
                dic(tmp) = k
                dArr(k, 1) = tmp
            End If
            
            indez = Application.Match(arrS2(r, 2), Sheet3.Range("B1:V1"), 0)
            If TypeName(indez) <> "Error" Then
                dArr(dic(tmp), indez + 1) = arrS2(r, 4)
            End If
        End If
    Next
    Sheet3.Range("A2:V10000").ClearContents
    If k > 0 Then Sheet3.Range("A2").Resize(k, 22).Value = dArr
End Sub

 

[thaihau2004]

Public Sub hello()
Dim arrS1, arrS2, r As Long, dic As Object, indez, dArr(1 To 10000, 1 To 22), k As Long, tmp
    arrS1 = Sheet1.Range("A2:D" & Sheet1.[A65000].End(xlUp).Row).Value2
    arrS2 = Sheet2.Range("A2:D" & Sheet2.[A65000].End(xlUp).Row).Value2
    Set dic = CreateObject("scripting.dictionary")
    For r = 1 To UBound(arrS1) Step 1
        dic(arrS1(r, 4) & ";" & arrS1(r, 2)) = arrS1(r, 3)
        dic(arrS1(r, 3)) = 0
    Next
    For r = 1 To UBound(arrS2) Step 1
        If dic.exists(arrS2(r, 1) & ";" & arrS2(r, 3)) Then
            tmp = dic(arrS2(r, 1) & ";" & arrS2(r, 3))
            If dic(tmp) = 0 Then
                k = k + 1
                dic(tmp) = k
                dArr(k, 1) = tmp
            End If
            
            indez = Application.Match(arrS2(r, 2), Sheet3.Range("B1:V1"), 0)
            If TypeName(indez) <> "Error" Then
                dArr(dic(tmp), indez + 1) = arrS2(r, 4)
            End If
        End If
    Next
    Sheet3.Range("A2:V10000").ClearContents
    If k > 0 Then Sheet3.Range("A2").Resize(k, 22).Value = dArr
End Sub

Đã chạy thành công! Cám ơn bạn AutoReply & hcminh2016 nhiều nhé, bài toán đau đầu cả mấy ngày nay đã dc các bác giải quyết giúp trong vài nốt nhạc Nếu 2 bác ở SG, nếu dc thì inbox mình số đt, cuối tuần rảnh mình mời cafe giao lưu, còn học hỏi các bác nhiều ^^'.

Regards!

 

[hcminh2016]

Đã chạy thành công! Cám ơn bạn AutoReply & hcminh2016 nhiều nhé, bài toán đau đầu cả mấy ngày nay đã dc các bác giải quyết giúp trong vài nốt nhạc Nếu 2 bác ở SG, nếu dc thì inbox mình số đt, cuối tuần rảnh mình mời cafe giao lưu, còn học hỏi các bác nhiều ^^'.

Regards!

Thôi cho số Púp Bờ Líc ở đây luôn. Khỏi in bốc...
1. Số của tôi: (08) 3 113
2. Của bạn Tự động trả lời ở trên: (061) 3 115

Gọi khi nào cũng được...có người bắt máy cả...

 

[thaihau2004]

Thôi cho số Púp Bờ Líc ở đây luôn. Khỏi in bốc...
1. Số của tôi: (08) 3 113
2. Của bạn Tự động trả lời ở trên: (061) 3 115

Gọi khi nào cũng được...có người bắt máy cả...

Haha, toàn hotline thế. Pó tay bác luôn -_-