Xin hỏi về gộp dữ liệu (2 người xem)

[vumian]

Dear all,

MÌnh có 1 giả thuyết về gộp 2 table, miêu tả như trong file, xin hỏi anh chị, các bác mình làm cách nào cho nhanh, hay và không thiếu xót ?

Có thề dùng hàm, giải pháp và VBA

Cám ơn,

Cập nhật mới : Thêm ví dụ cụ thể

 

[duongdv]

Bài toán của bạn có vẻ trìu tượng đấy. Tớ đọc qua mà không hiểu

 

[vumian]

Bác SA,

Gộp vô A cũng được, hay cho ra 1 sheet mới cũng được, điều quan trọng là nhận biết dữ liệu của A hay B sau khi, và một vài điều ghi ghú như trong file

Thanks bác

 

[SA_DQ]

Hãy thử với macro này & cho biết vài thông tin về nó

Option Explicit:                                Option Base 1
 Dim jJ As Long, Jw As Long, lRowA As Long, lRowB As Long
Sub GopDuLieu()
 
 lRowA = Sheets("A").[b65432].End(xlUp).Row
 lRowB = Sheets("B").[b65432].End(xlUp).Row
 ReDim MgDL(lRowB - 2) As Boolean
 With Sheets("A")
    For jJ = 3 To lRowA
        For Jw = 3 To lRowB
            If .Cells(jJ, 2) = Sheets("B").Cells(Jw, 2) Then
                .Cells(jJ, 3) = Sheets("B").Cells(Jw, 3)
                MgDL(Jw - 2) = True:                Exit For
            End If
    Next Jw, jJ
    For Jw = 3 To lRowB
        If Not MgDL(Jw - 2) Then
            .Range("B" & .[b65432].End(xlUp).Row + 1) = Sheets("B").Cells(Jw, 2)
            .Range("C" & .[b65432].End(xlUp).Row) = Sheets("B").Cells(Jw, 3)
        End If
    Next Jw
 End With
End Sub

 

[vumian]

Bác ơi,

Tuy là mang ý nghĩa gộp, nhưng nếu khi gộp thì dữ liệu chủ yếu dựa trên table 2,
Table mới sau khi gộp như ví dụ, thì hạng mục bbb,ccc,ddd không còn mới đúng
Đã đưa table mẫu sau khi gộp vào file, Bác xem giúp

Bác xem lại giúp

 

[SA_DQ]

(/ậy cho vô sheet mới có tên là 'Gop' vậy

Bác ơi, Tuy là mang ý nghĩa gộp, nhưng nếu khi gộp thì dữ liệu chủ yếu dựa trên table 2,
Table mới sau khi gộp như ví dụ, thì hạng mục bbb,ccc,ddd không còn mới đúng
Đã đưa table mẫu sau khi gộp vào file, Bác xem giúp Bác xem lại giúp

 Option Explicit:                                Option Base 1
 Dim jJ As Long, Jw As Long, lRowA As Long, lRowB As Long, lRowG As Long
Sub GopDuLieu()
  
 lRowA = Sheets("A").[b65432].End(xlUp).Row
 lRowB = Sheets("B").[b65432].End(xlUp).Row
 ReDim MgDL(lRowB - 2) As Boolean
 
 With Sheets("Gop")
    .Range("A2:K" & (lRowA + lRowB)).Clear
    Sheets("A").[b2].Resize(1, 9).Copy Destination:=.[b2]
    For jJ = 3 To lRowA
        For Jw = 3 To lRowB
            If Sheets("A").Cells(jJ, 2) = Sheets("B").Cells(Jw, 2) Then
                lRowG = .[b65432].End(xlUp).Row + 1
                Sheets("A").Cells(jJ, 2).Resize(1, 9).Copy _
                    Destination:=.Range("B" & lRowG)
                .Range("C" & lRowG) = Sheets("B").Cells(Jw, 3)
                MgDL(Jw - 2) = True:                Exit For
            End If
    Next Jw, jJ
    For Jw = 3 To lRowB
        If Not MgDL(Jw - 2) Then
            lRowG = .[b65432].End(xlUp).Row + 1
            .Range("B" & lRowG) = Sheets("B").Cells(Jw, 2)
            .Range("C" & lRowG) = Sheets("B").Cells(Jw, 3)
        End If
    Next Jw
 End With
End Sub

 

[vumian]

ý, Bác ơi,

Hehe, Thanks bác nhiều lám, giờ chỉ còn 1 công việc nhỏ nữa thôi, Có hứong đi rồi

 

[SA_DQ]

Nếu muốn chép chung vô sheetA

Thì sửa macro ở #4 như sau:

Option Explicit:                                Option Base 1
 Dim jJ As Long, Jw As Long, lRowA As Long, lRowB As Long
Sub GopDuLieu()
 
 lRowA = Sheets("A").[b65432].End(xlUp).Row
 lRowB = Sheets("B").[b65432].End(xlUp).Row
 ReDim MangB(lRowB - 2) As Boolean: ReDim MangA(lRowA - 2) As Boolean '1'
 Dim Rng As Range
 With Sheets("A")
    For jJ = 3 To lRowA
        For Jw = 3 To lRowB
            If .Cells(jJ, 2) = Sheets("B").Cells(Jw, 2) Then
                .Cells(jJ, 3) = Sheets("B").Cells(Jw, 3):           MangA(jJ - 2) = True '2'
                MangB(Jw - 2) = True:                Exit For
            End If
    Next Jw, jJ
 'Thêm:'
    For jJ = 3 To lRowA
        If Not MangA(jJ - 2) Then
            If Rng Is Nothing Then
                Set Rng = .Cells(jJ, 1)
            Else
                Set Rng = Union(Rng, .Cells(jJ, 1))
        End If:     End If
    Next jJ
    Rng.EntireRow.Delete
'Hết thêm'    
    For Jw = 3 To lRowB
        If Not MangB(Jw - 2) Then
            .Range("B" & .[b65432].End(xlUp).Row + 1) = Sheets("B").Cells(Jw, 2)
            .Range("C" & .[b65432].End(xlUp).Row) = Sheets("B").Cells(Jw, 3)
        End If
    Next Jw
 End With
End Sub

 

[vumian]

Bác SA, bác HYen ơi,

KẾt quả của 2 đoạn code trên ra kết quả giống hệt nhau, nhưng đều mong muốn là hạng ở 2 table giống 100% thì chỉ tồn tại 1 mà thôi,

Kết quả 2 bác ra là 7 dòng, nhưng chỉ cần 5 dòng thôi, vì có 3 dòng trùng đó

Thanks,
vumian

 

[vumian]

Hai bác ơi,

Em ccó 1 lỗi về giải thuật, hai bác mở file xem giúp

Cám ơn nhiều,

 

[SA_DQ]

Đối chiếu với cái ni, nha:

Option Explicit
Dim ds6 As Long, ds7 As Long
Dim lRowS6 As Long, lRowS7 As Long

Sub ThemHangMuc()
 lRowS6 = Sheet6.[B65432].End(xlUp).Row
 lRowS7 = Sheet7.[B65432].End(xlUp).Row
With Sheet6 ' Sheet A'
    For ds6 = 9 To lRowS6
        For ds7 = 9 To lRowS7
            If .Range("B" & ds6) = Sheet7.Range("B" & ds7) Then Exit For
         Next ds7
        If ds7 > lRowS7 And WorksheetFunction.Sum(.Range("I" & ds6 & ":S" & ds6)) > 0 Then
9  '            MsgBox ds7, , ds6''
            .Range("B" & ds6 & ":S" & ds6).Copy _
                  Destination:=Sheet7.[B65432].End(xlUp).Offset(1, 0)
        End If
    Next ds6
End With
End Sub

 

[SA_DQ]

Bạn dùng 1 vòng lặp sẽ nhanh hơn 2 vòng lặp, như sau

Hai bác ơi, Em ccó 1 lỗi về giải thuật, hai bác mở file xem giúp
Cám ơn nhiều,

Option Explicit 
Dim ds6 As Long, ds7 As Long 
Dim lRowS6 As Long, lRowS7 As Long 
Dim Timer_ As Double 
 
Sub FindAndCopy()
Dim Rng As Range, Clls As Range
 
  Timer_ = Timer
lRowS7 = Sheet7.[b65432].End(xlUp).Row
With Sheet6
   For ds6 = 9 To .[b65432].End(xlUp).Row
      Set Clls = Sheet7.Columns("B:B").Find(.Cells(ds6, 2), LookIn:=xlValues, _
         LookAt:=xlWhole)
      If Clls Is Nothing Then
         If Rng Is Nothing Then
            Set Rng = .Cells(ds6, 2).Resize(1, 18)
         Else
            Set Rng = Union(Rng, .Cells(ds6, 2).Resize(1, 18))
      End If:           End If
   Next ds6
End With
If Not Rng Is Nothing Then _
   Rng.Copy Destination:=Sheet7.Cells(lRowS7 + 1, 2)
MsgBox Timer - Timer_    'Không quá .015625 gy nếu Sheet7 có 1.000 records dữ liệu'
End Sub

 

[vumian]

Hai bác ơi,

Code của bác SA, số 9 phía sau 'then', có ý nghĩa gì vậy, chưa thấy bao giờ ?

Sau khi thêm rồi, em muốn tô màu để phân biệt, em thêm dòng code sau lệnh copy,mà nó tô màu bậy

Sheet7.Range("B" & ds6 & ":S" & ds6).Font.ColorIndex = 5

 

[SA_DQ]

1*/ Số 9, cũng như các số khác ở đầu các dòng lệnh dùng để đánh số các dòng lệnh;
Rất có í nghĩa khi cần tìm dòng lệnh bị lỗi
Chúng ta có thể viết & kiểm chứng bằng macro như sau

 Sub BayLoi()
 On Error GoTo LoiCT
 Dim VH As Integer

1     MsgBox "1"
2     MsgBox Str(4 / VH)
3     MsgBox "3"
Err_CT:           Exit Sub
LoiCT:
       Select Case Err
       Case 13
            Resume Next
       Case Else
            MsgBox Error$, , Erl:              Resume Err_CT
       End Select
 End Sub

2*/ Tô màu vùng vừa chép bằng câu lệnh sau:

[B]Sub ThemHangMuc() [/B]
' . . . . . . . . . . . . . .   '
'. . . . . . . .  . . . . . . .  '

9  [COLOR="LightBlue"]'            MsgBox ds7, , ds6'[/COLOR]    
 [COLOR="DarkOrchid"]       .Range("B" & ds6 & ":S" & ds6).Copy _
                  Destination:=Sheet7.[b65432].End(xlUp).Offset(1, 0)[/COLOR]      
      Sheet7.Range("B" & Sheet7.[b65432].End(xlUp).Row & ":S" & _
               Sheet7.[b65432].End(xlUp).Row).Interior.ColorIndex = 5
  [COLOR="darkorchid"]      End If
    Next ds6
End With[/COLOR]
[B]End Sub[/B]