Ghép các trường trùng nhau vào 1 sheet

Phương Phương mito · 1/10/21

Kính gửi ANh chị,
Em muốn dùng phương pháp mảng để ghép số liệu 2 sheet mà chưa làm được. Mong anh chị giúp đỡ ạ.
- Em có hai sheet Data1 và Data2. Khác nhau về số cột vị trí cột nhưng có các trường trùng nhau. Bài toán là em muốn
+ Gán dữ liệu hai Data này vào 2 mảng arr1 và arr2
+ Sau đó muốn ghép chung số liệu là các trường chung của hai mảng này vào sheet Ghép liên tiếp, các trường chung và muốn lấy em có đánh dấu x ở dòng 1 mỗi Data (Gồm các trường như ở sheet Ghep)
Mong anh chị hỗ trợ code ạ ! Em cảm ơn.

Cá ngừ F1 · 1/10/21

Power Query có chức năng Append các table lại, xong rồi remove các cột muốn remove (mà hình như có lần bạn bảo dùng bộ Office cũ không có PQ), chứ không thì mất vài giây là xong đó.

Hai Lúa Miền Tây · 1/10/21

Phương Phương mito đã viết:
Kính gửi ANh chị,
Em muốn dùng phương pháp mảng để ghép số liệu 2 sheet mà chưa làm được. Mong anh chị giúp đỡ ạ.
- Em có hai sheet Data1 và Data2. Khác nhau về số cột vị trí cột nhưng có các trường trùng nhau. Bài toán là em muốn
+ Gán dữ liệu hai Data này vào 2 mảng arr1 và arr2
+ Sau đó muốn ghép chung số liệu là các trường chung của hai mảng này vào sheet Ghép liên tiếp, các trường chung và muốn lấy em có đánh dấu x ở dòng 1 mỗi Data (Gồm các trường như ở sheet Ghep)
Mong anh chị hỗ trợ code ạ ! Em cảm ơn.

Bạn có thể dùng code sau nhé:

Mã:

Sub Ghep_HLMT()
    Dim strField As String, cn as String
    strField = " [TS],[Customer / Supplier],[Reference],[Description],[Inclusive Amount],[Account Number],[Exclusive Amount] "
    cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
    With CreateObject("ADODB.Recordset")
        .Open ("Select " & strField & " From [Data1$A2:N] Union All Select " & strField & " From [Data2$A2:K] "), cn
        Sheet3.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub

Phương Phương mito · 1/10/21

Cá ngừ F1 đã viết:
Power Query có chức năng Append các table lại, xong rồi remove các cột muốn remove (mà hình như có lần bạn bảo dùng bộ Office cũ không có PQ), chứ không thì mất vài giây là xong đó.

Em muốn dùng arr cơ ạ. PQ em không rành anh ạ.

Maika8008 · 1/10/21

Phương Phương mito đã viết:
Kính gửi ANh chị,
Em muốn dùng phương pháp mảng để ghép số liệu 2 sheet mà chưa làm được. Mong anh chị giúp đỡ ạ.
- Em có hai sheet Data1 và Data2. Khác nhau về số cột vị trí cột nhưng có các trường trùng nhau. Bài toán là em muốn
+ Gán dữ liệu hai Data này vào 2 mảng arr1 và arr2
+ Sau đó muốn ghép chung số liệu là các trường chung của hai mảng này vào sheet Ghép liên tiếp, các trường chung và muốn lấy em có đánh dấu x ở dòng 1 mỗi Data (Gồm các trường như ở sheet Ghep)
Mong anh chị hỗ trợ code ạ ! Em cảm ơn.

Code và file

Rich (BB code):

Sub Ghep()
    Dim arr1, arr2, aF1, aF2, aRsl
    Dim i&, j&, Ub1&
    
    arr1 = Sheet1.Range("A3:N" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    arr2 = Sheet2.Range("A3:K" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row)
    ReDim aRsl(1 To UBound(arr1) + UBound(arr2), 1 To 7)
    aF1 = Array(1, 3, 4, 9, 5, 6, 13)
    aF2 = Array(1, 3, 4, 5, 6, 7, 10)
    Ub1 = UBound(arr1)
    For i = 1 To Ub1
        For j = 0 To UBound(aF1)
            aRsl(i, j + 1) = arr1(i, aF1(j))
        Next
    Next
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(aF2)
            aRsl(i + Ub1, j + 1) = arr2(i, aF2(j))
        Next
    Next
    Application.ScreenUpdating = False
    Sheet3.Range("A2").Resize(50000, 7).ClearContents
    Sheet3.Range("A2").Resize(UBound(arr1) + UBound(arr2), 7) = aRsl
    Application.ScreenUpdating = True
End Sub

Phương Phương mito · 1/10/21

Maika8008 đã viết:

Code và file

Rich (BB code):

Sub Ghep()
    Dim arr1, arr2, aF1, aF2, aRsl
    Dim i&, j&, Ub1&
   
    arr1 = Sheet1.Range("A3:N" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
    arr2 = Sheet2.Range("A3:K" & Sheet2.Range("A" & Rows.Count).End(xlUp).Row)
    ReDim aRsl(1 To UBound(arr1) + UBound(arr2), 1 To 7)
    aF1 = Array(1, 3, 4, 9, 5, 6, 13)
    aF2 = Array(1, 3, 4, 5, 6, 7, 10)
    Ub1 = UBound(arr1)
    For i = 1 To Ub1
        For j = 0 To UBound(aF1)
            aRsl(i, j + 1) = arr1(i, aF1(j))
        Next
    Next
    For i = 1 To UBound(arr2)
        For j = 0 To UBound(aF2)
            aRsl(i + Ub1, j + 1) = arr2(i, aF2(j))
        Next
    Next
    Application.ScreenUpdating = False
    Sheet3.Range("A2").Resize(50000, 7).ClearContents
    Sheet3.Range("A2").Resize(UBound(arr1) + UBound(arr2), 7) = aRsl
    Application.ScreenUpdating = True
End Sub

Đúng là phương pháp em cần ạ ! Em cảm ơn anh nhiều !

Bài đã được tự động gộp: 1/10/21

Hai Lúa Miền Tây đã viết:

Bạn có thể dùng code sau nhé:

Mã:

Sub Ghep_HLMT()
    Dim strField As String
    strField = " [TS],[Customer / Supplier],[Reference],[Description],[Inclusive Amount],[Account Number],[Exclusive Amount] "
    cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
    With CreateObject("ADODB.Recordset")
        .Open ("Select " & strField & " From [Data1$A2:N] Union All Select " & strField & " From [Data2$A2:K] "), cn
        Sheet3.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub

Một cách hay và ngắn gọn ạ ! Em cảm ơn nhiều ạ !

Cá ngừ F1 · 1/10/21

Vậy thì dùng code này:

Mã:

Sub GopData()
Dim Data1(), Data2(), i&, KQ1(), KQ2(), j&
Data1 = Range(Sheet1.[A2], Sheet1.[N100000].End(3))
Data2 = Range(Sheet2.[A2], Sheet2.[K100000].End(3))
ReDim KQ1(1 To UBound(Data1), 1 To 7)
ReDim KQ2(1 To UBound(Data2), 1 To 7)
For i = 1 To UBound(Data1)
    KQ1(i, 1) = Data1(i, 1)
    KQ1(i, 2) = Data1(i, 3)
    KQ1(i, 3) = Data1(i, 4)
    KQ1(i, 4) = Data1(i, 9)
    KQ1(i, 5) = Data1(i, 5)
    KQ1(i, 6) = Data1(i, 6)
    KQ1(i, 7) = Data1(i, 13)
Next
For j = 1 To UBound(Data2)
    KQ2(j, 1) = Data2(j, 1)
    KQ2(j, 2) = Data2(j, 3)
    KQ2(j, 3) = Data2(j, 4)
    KQ2(j, 4) = Data2(j, 5)
    KQ2(j, 5) = Data2(j, 6)
    KQ2(j, 6) = Data2(j, 7)
    KQ2(j, 7) = Data2(j, 10)
Next
Sheet3.[A2].Resize(i - 1, 7) = KQ1
Sheet3.Range("A" & i + 1).Resize(j - 1, 7) = KQ2
End Sub

Hai Lúa Miền Tây · 1/10/21

Phương Phương mito đã viết:
Đúng là phương pháp em cần ạ ! Em cảm ơn anh nhiều !

Bài đã được tự động gộp: 1/10/21

Một cách hay và ngắn gọn ạ ! Em cảm ơn nhiều ạ !

Tôi đoán là bạn chưa thử code trên của tôi. Nó phải như sau:

Mã:

Sub Ghep_HLMT()
    Dim strField As String, cn As String
    strField = " [TS],[Customer / Supplier],[Reference],[Account Number],[Description],[Inclusive Amount],[Exclusive Amount] "
    cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
    With CreateObject("ADODB.Recordset")
        .Open ("Select " & strField & " From [Data1$A2:N] Union All Select " & strField & " From [Data2$A2:K] "), cn
        Sheet3.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub

@befaint cười gì em nhỉ

Cá ngừ F1 · 1/10/21

Phương Phương mito đã viết:
Em muốn dùng arr cơ ạ. PQ em không rành anh ạ.

Cứ thử một lần xem sao, không bổ dọc thì bổ ngang bạn ơi.

befaint · 1/10/21

Hai Lúa Miền Tây đã viết:
@befaint cười gì em nhỉ

Cô bé thớt không để ý những cách khác đâu anh. Lúc nào cũng kiên định ý kiến ban đầu.

Cá ngừ F1 · 1/10/21

Code gộp của anh @Maika8008 bài #5 tôi thấy thiếu 2 bản ghi.
Tôi gửi bạn File, dùng cả PQ và VBA.
Nói chung cách nào cũng hay, mà PQ sẽ có table đẹp, tiện cho việc truy vẫn tiếp.

Bài đã được tự động gộp: 1/10/21

Hai Lúa Miền Tây đã viết:

Tôi đoán là bạn chưa thử code trên của tôi. Nó phải như sau:

Mã:

Sub Ghep_HLMT()
    Dim strField As String
    strField = " [TS],[Customer / Supplier],[Reference],[Account Number],[Description],[Inclusive Amount],[Exclusive Amount] "
    cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
    With CreateObject("ADODB.Recordset")
        .Open ("Select " & strField & " From [Data1$A2:N] Union All Select " & strField & " From [Data2$A2:K] "), cn
        Sheet3.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub

@befaint cười gì em nhỉ

anh Hai Lúa ơi
Em chạy thử thì lỗi này

Maika8008 · 1/10/21

Cá ngừ F1 đã viết:
Code gộp của anh @Maika8008 bài #5 tôi thấy thiếu 2 bản ghi.

Chà! Tôi thấy data1 có 206, data2 có 94, cộng lại là 300 bản ghi kết quả đủ mà nhỉ?

Cá ngừ F1 · 1/10/21

Maika8008 đã viết:
Chà! Tôi thấy data1 có 206, data2 có 94, cộng lại là 300 bản ghi kết quả đủ mà nhỉ?

Kết quả của anh có 298 record (trừ 1 dòng tiêu đề), em copy nguyên code của a để chạy đó. anh chạy thử file bài #11

Maika8008 · 1/10/21

Cá ngừ F1 đã viết:
Kết quả của anh có 298 record (trừ 1 dòng tiêu đề), em copy nguyên code của a để chạy đó. anh chạy thử file bài #11

View attachment 267078

Thế thì không biết thế nào chứ máy tôi kết quả như sau

----------------------------------------------------------------------------------------------------------- $$$$@

Hai Lúa Miền Tây · 1/10/21

Cá ngừ F1 đã viết:
Code gộp của anh @Maika8008 bài #5 tôi thấy thiếu 2 bản ghi.
Tôi gửi bạn File, dùng cả PQ và VBA.
Nói chung cách nào cũng hay, mà PQ sẽ có table đẹp, tiện cho việc truy vẫn tiếp.

Bài đã được tự động gộp: 1/10/21

anh Hai Lúa ơi
Em chạy thử thì lỗi này
View attachment 267076

Nếu em bỏ dòng đầu của Data1 và Data2 đi thì phải chỉnh lại vùng nhé.

Mã:

Sub Ghep_HLMT()
    Dim strField As String, cn As String
    strField = " [TS],[Customer / Supplier],[Reference],[Account Number],[Description],[Inclusive Amount],[Exclusive Amount] "
    cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
    With CreateObject("ADODB.Recordset")
        .Open ("Select " & strField & " From [Data1$] Union All Select " & strField & " From [Data2$] "), cn
        Sheet3.Range("A2").CopyFromRecordset .DataSource
    End With
End Sub

Cá ngừ F1 · 1/10/21

Ah, ah, xin lỗi 2 anh @Maika8008, @Hai Lúa Miền Tây, e xóa cái dòng đầu có mấy dấu x, x của chủ thớt đi.

Ba Tê · 2/10/21

Phương Phương mito đã viết:
Kính gửi ANh chị,
Em muốn dùng phương pháp mảng để ghép số liệu 2 sheet mà chưa làm được. Mong anh chị giúp đỡ ạ.
- Em có hai sheet Data1 và Data2. Khác nhau về số cột vị trí cột nhưng có các trường trùng nhau. Bài toán là em muốn
+ Gán dữ liệu hai Data này vào 2 mảng arr1 và arr2
+ Sau đó muốn ghép chung số liệu là các trường chung của hai mảng này vào sheet Ghép liên tiếp, các trường chung và muốn lấy em có đánh dấu x ở dòng 1 mỗi Data (Gồm các trường như ở sheet Ghep)
Mong anh chị hỗ trợ code ạ ! Em cảm ơn.

Thay vì đánh dấu x thì bạn nhập số cột cần đưa vào sheet "Ghep" cho trực quan, khi vị trí các cột "loạn xà ngầu" cũng dễ chỉnh sửa.

Phương Phương mito · 2/10/21

Cá ngừ F1 đã viết:

Vậy thì dùng code này:

Mã:

Sub GopData()
Dim Data1(), Data2(), i&, KQ1(), KQ2(), j&
Data1 = Range(Sheet1.[A2], Sheet1.[N100000].End(3))
Data2 = Range(Sheet2.[A2], Sheet2.[K100000].End(3))
ReDim KQ1(1 To UBound(Data1), 1 To 7)
ReDim KQ2(1 To UBound(Data2), 1 To 7)
For i = 1 To UBound(Data1)
    KQ1(i, 1) = Data1(i, 1)
    KQ1(i, 2) = Data1(i, 3)
    KQ1(i, 3) = Data1(i, 4)
    KQ1(i, 4) = Data1(i, 9)
    KQ1(i, 5) = Data1(i, 5)
    KQ1(i, 6) = Data1(i, 6)
    KQ1(i, 7) = Data1(i, 13)
Next
For j = 1 To UBound(Data2)
    KQ2(j, 1) = Data2(j, 1)
    KQ2(j, 2) = Data2(j, 3)
    KQ2(j, 3) = Data2(j, 4)
    KQ2(j, 4) = Data2(j, 5)
    KQ2(j, 5) = Data2(j, 6)
    KQ2(j, 6) = Data2(j, 7)
    KQ2(j, 7) = Data2(j, 10)
Next
Sheet3.[A2].Resize(i - 1, 7) = KQ1
Sheet3.Range("A" & i + 1).Resize(j - 1, 7) = KQ2
End Sub

Em cảm ơn anh ạ. Nhìn rất dễ hiểu và trực quan ạ !

Bài đã được tự động gộp: 2/10/21

Ba Tê đã viết:
Thay vì đánh dấu x thì bạn nhập số cột cần đưa vào sheet "Ghep" cho trực quan, khi vị trí các cột "loạn xà ngầu" cũng dễ chỉnh sửa.

Em có đọc một số Code của Anh, code rất gọn và chạy nhanh ạ ! Em cảm ơn a nhiều ạ !

Cá ngừ F1 · 2/10/21

Phương Phương mito đã viết:
Em cảm ơn anh ạ. Nhìn rất dễ hiểu và trực quan ạ !

Bài đã được tự động gộp: 2/10/21

Em có đọc một số Code của Anh, code rất gọn và chạy nhanh ạ ! Em cảm ơn a nhiều ạ !

Để thu gọn 7 dòng trong vòng for next bằng 1 dòng thì bạn có thể làm như anh @Maika8008, đặt 1 Arr là số thứ tự các cột

Ghép các trường trùng nhau vào 1 sheet

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

File đính kèm

( ͡° ͜ʖ ͡°)

❆❆❆❆❆❆❆❆

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

Thành viên gạo cội

File đính kèm

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

( ͡° ͜ʖ ͡°)

❆❆❆❆❆❆❆❆

( ͡° ͜ʖ ͡°)

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

( ͡° ͜ʖ ͡°)

File đính kèm

Thành viên gạo cội

( ͡° ͜ʖ ͡°)

Thành viên gạo cội

❆❆❆❆❆❆❆❆

( ͡° ͜ʖ ͡°)

Cạo Rồi Khỏi Gội

File đính kèm

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

( ͡° ͜ʖ ͡°)