Dò dữ liệu trùng

Liên hệ QC
Thien

Thien

Thành viên thường trực
Tham gia
23/6/06
Bài viết
352
Được thích
112
Thân chào cả nhà.

Mình muốn dò dữ liệu cột C ở sheet 1 và dữ liệu cột D ở sheet 2 nếu trùng thì chép dl của 02 sheet sang sheet 3 (dl sheet 2 ở trên rồi tới dl của sheet 1 ).

Mong các bạn giúp đỡ.

Thân chào.
 

File đính kèm

  • Copy du lieu do trung 2 sheet sang sheet 3.xls
    41 KB · Đọc: 16
1.
Thien đã viết:
Mình muốn dò dữ liệu cột C ở sheet 1 và dữ liệu cột D ở sheet 2
Nhấp chuột vào đây để mở rộng...
Hay cột B ở sheet 1 và dữ liệu cột C ở sheet 2
2.
Thien đã viết:
nếu trùng thì chép dl của 02 sheet sang sheet 3 (dl sheet 2 ở trên rồi tới dl của sheet 1 )
Nhấp chuột vào đây để mở rộng...
Nếu trùng thì dữ liệu 2 sheet giống nhau rồi sao lại "chép dl của 02 sheet sang sheet 3"
3. Dùng VBA được không bạn, công thức phức tạp hơn
 
Lần chỉnh sửa cuối:
viehoai đã viết:
1.

Hay cột B ở sheet 1 và dữ liệu cột C ở sheet 2
2.

Nếu trùng thì dữ liệu 2 sheet giống nhau rồi sao lại "chép dl của 02 sheet sang sheet 3"
3. Dùng VBA được không bạn, công thức phức tạp hơn
Nhấp chuột vào đây để mở rộng...

Dạ không bạn ơi
Mình muốn tìm số tiền trùng nên phải lấy dữ liệu cột C ở sheet 1 và dữ liệu cột D ở sheet 2.
Khi thấy dl trùng thì copy dữ liệu trùng sang sheet 3 để kiểm tra.
Do dl mình đưa lên không có số trùng nên bạn thêm vài dl trùng vào hộ mình nha.

Mình thích VBA hơn công thức.

Thân chào.
 
Lần chỉnh sửa cuối:
Thien đã viết:
Dạ không bạn ơi
Mình muốn tìm số tiền trùng nên phải lấy dữ liệu cột C ở sheet 1 và dữ liệu cột D ở sheet 2.
Khi thấy dl trùng thì copy dữ liệu trùng sang sheet 3 để kiểm tra.
Do dl mình đưa lên không có số trùng nên bạn thêm vài dl trùng vào hộ mình nha.

Mình thích VBA hơn công thức.

Thân chào.
Nhấp chuột vào đây để mở rộng...
Bạn test code này thử nhé
Mã: 
Option ExplicitSub DLtrung()
Dim Arr1(), Arr2(), ArrKQ(), Tmp(), Dic
Dim i As Long, j As Long
Arr1 = Sheet1.Range("C2:C23").Value
Arr2 = Sheet2.Range("D2:D88").Value
 Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr1)
   For j = 1 To UBound(Arr2)
      If Arr1(i, 1) = Arr2(j, 1) And Not Dic.Exists(Arr2(j, 1)) Then
         Dic.Add Arr2(j, 1), ""
         GoTo NextI
      End If
   Next
NextI:
Next
Tmp = Dic.keys
ReDim ArrKQ(1 To Dic.Count, 1 To 1)
For i = 1 To Dic.Count
   ArrKQ(i, 1) = Tmp(i - 1)
Next
Sheet3.Range("A1").Resize(Dic.Count).Value = ArrKQ
Set Dic = Nothing
End Sub
 
viehoai đã viết:
Bạn test code này thử nhé
Mã: 
Option ExplicitSub DLtrung()
Dim Arr1(), Arr2(), ArrKQ(), Tmp(), Dic
Dim i As Long, j As Long
Arr1 = Sheet1.Range("C2:C23").Value
Arr2 = Sheet2.Range("D2:D88").Value
 Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr1)
   For j = 1 To UBound(Arr2)
      If Arr1(i, 1) = Arr2(j, 1) And Not Dic.Exists(Arr2(j, 1)) Then
         Dic.Add Arr2(j, 1), ""
         GoTo NextI
      End If
   Next
NextI:
Next
Tmp = Dic.keys
ReDim ArrKQ(1 To Dic.Count, 1 To 1)
For i = 1 To Dic.Count
   ArrKQ(i, 1) = Tmp(i - 1)
Next
Sheet3.Range("A1").Resize(Dic.Count).Value = ArrKQ
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Chân thành cảm ơn bạn đã quan tâm.
Coce có vài vấn đề chưa đúng ý mình. Bạn xem lại hộ kết quả mà mình muốn trong file đính kèm nhen. (có thể thêm cột trồng bên sheet 1 vào để đồng bộ với sheet 2 nhằm copy sang sheet 3 dễ hơn).
Không biết có thể dùng ADO để giải quyết vấn đề này không?


Thân.
 

File đính kèm

  • Copy du lieu do trung 2 sheet sang sheet 3.xls
    55.5 KB · Đọc: 11
Lần chỉnh sửa cuối:
Thien đã viết:
Chân thành cảm ơn bạn đã quan tâm.
Coce có vài vấn đề chưa đúng ý mình. Bạn xem lại hộ kết quả mà mình muốn trong file đính kèm nhen. (có thể thêm cột trồng bên sheet 1 vào để đồng bộ với sheet 2 nhằm copy sang sheet 3 dễ hơn).
Không biết có thể dùng ADO để giải quyết vấn đề này không?


Thân.
Nhấp chuột vào đây để mở rộng...

Sao kỳ vậy ta, ai lại dò số tiền, thôi thì làm đại, đúng sai bạn tự kiểm tra nhé.

Mã: 
Sub DLTrung_HLMT()
  Dim cn As Object, adoRS As Object
  Set cn = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  On Error GoTo BaoLoi
        With cn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                           "Data Source=" & ThisWorkbook.FullName & _
                                           ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        With adoRS
            .ActiveConnection = cn
            .Open "SELECT [Sheet2$].F1, [Sheet2$].F2, [Sheet2$].F3, [Sheet2$].F4, [Sheet2$].F5, [Sheet2$].F6 " & _
                        "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].F3 = [Sheet2$].F4;"
        End With
        With Sheets("Sheet3")
            .Range("A1:G65000").ClearContents
            .Range("B1").CopyFromRecordset adoRS
                With .Range("A1:A" & .Range("B65000").End(xlUp).Row)
                       .FormulaR1C1 = "=ROW()"
                       .Value = .Value
                End With
            .Activate
        End With
        adoRS.Close: cn.Close
        Set cn = Nothing: Set adoRS = Nothing
    Exit Sub
BaoLoi:
MsgBox Err.Description

End Sub
 

File đính kèm

  • Copy du lieu do trung 2 sheet sang sheet 3.xls
    63.5 KB · Đọc: 5
Thân chào Hai Lúa Miền Tây.

Một chút nữa thôi là đúng ý mình rồi.
Bạn chỉnh lại copy luôn dữ liệu trùng bên sheet 1 sang sheet 3 nha (Trong file ở bài #5).

Thân.
 
Thien đã viết:
Thân chào Hai Lúa Miền Tây.

Một chút nữa thôi là đúng ý mình rồi.
Bạn chỉnh lại copy luôn dữ liệu trùng bên sheet 1 sang sheet 3 nha (Trong file ở bài #5).

Thân.
Nhấp chuột vào đây để mở rộng...
Thế thì bạn gom dữ liệu sheet1 và sheet2 lại là được.

Mã: 
Sub DLTrung_HLMT()
  Dim cn As Object, adoRS As Object
  Set cn = CreateObject("ADODB.Connection")
  Set adoRS = CreateObject("ADODB.Recordset")
  On Error GoTo BaoLoi
        With cn
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                                           "Data Source=" & ThisWorkbook.FullName & _
                                           ";Extended Properties=""Excel 8.0;HDR=No;"";"
            .Open
        End With
        With adoRS
            .ActiveConnection = cn
            .Open "SELECT F1, F2, F3, F4, F5, F6 FROM (SELECT [Sheet2$].F1, [Sheet2$].F2, [Sheet2$].F3, [Sheet2$].F4, " & _
                      "[Sheet2$].F5, [Sheet2$].F6 " & _
                      "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].F3 = [Sheet2$].F4) " & _
                      "Union all " & _
                      "SELECT [Sheet1$].F1, null, [Sheet1$].F2, [Sheet1$].F3,null,null " & _
                      "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].F3 = [Sheet2$].F4 " & _
                      "order by F4;"
        End With
        With Sheets("Sheet3")
            .Range("A1:G65000").ClearContents
            .Range("B1").CopyFromRecordset adoRS
                With .Range("A1:A" & .Range("B65000").End(xlUp).Row)
                       .FormulaR1C1 = "=ROW()"
                       .Value = .Value
                End With
            .Activate
        End With
        adoRS.Close: cn.Close
        Set cn = Nothing: Set adoRS = Nothing
    Exit Sub
BaoLoi:
MsgBox Err.Description

End Sub
 
Em có file quản lý đi đến như trong đính kèm. Nếu một người có tên trong cột họ tên đã đến mà chưa đi thì khi nhập vào sẽ thông báo là người đó đã được nhập để ta không nhập thêm. Nhờ các bác xem giúp. Xin cảm ơn!
 

File đính kèm

  • TIM TRUNG.xls
    13.5 KB · Đọc: 8
Thien đã viết:
Thân chào cả nhà.

Mình muốn dò dữ liệu cột C ở sheet 1 và dữ liệu cột D ở sheet 2 nếu trùng thì chép dl của 02 sheet sang sheet 3 (dl sheet 2 ở trên rồi tới dl của sheet 1 ).

Mong các bạn giúp đỡ.

Thân chào.
Nhấp chuột vào đây để mở rộng...
Bạn xem thử đúng chưa nhé!
Mã: 
Sub DLtrung1()DC1 = Sheet1.Range("C65536").End(xlUp).Row
DC2 = Sheet2.Range("D65536").End(xlUp).Row
K = 1
If DC1 < 2 Then DC1 = 2
If DC2 < 2 Then DC2 = 2
Sheet3.Range("A1:F65536").ClearContents
For i = 2 To DC2
    Dem = Application.WorksheetFunction.CountIf(Sheet1.Range("C2:C" & DC1), Sheet2.Range("D" & i).Value)
        If Dem > 0 Then
            Sheet3.Range("A" & K & ":F" & K).Value = Sheet2.Range("A" & i & ":F" & i).Value
            K = K + 1
            With Sheet1.Range(Sheet1.[C2], Sheet1.[C65000].End(xlUp))
                Sheet3.Range("A" & K).Value = .Find(Sheet2.Range("D" & i).Value, , , xlWhole).Offset(, -2)
                Sheet3.Range("C" & K).Value = .Find(Sheet2.Range("D" & i).Value, , , xlWhole).Offset(, -1)
                Sheet3.Range("D" & K).Value = .Find(Sheet2.Range("D" & i).Value, , , xlWhole).Offset(, 0)
            End With
            K = K + 1
         End If
Next i
End Sub
 

File đính kèm

  • Copy du lieu do trung 2 sheet sang sheet 3.xls
    52 KB · Đọc: 10
Chân thành cảm ơn Hai Lúa Miền Tây và hanhpptc đã quan tâm giúp đỡ.

Cả 02 code đều ra kết quả đúng như ý muốn.
Trường hợp mình muốn gom dữ liệu sheet1 và sheet2 lại rồi nhóm từng công ty lại với nhau có được không?
(do dữ liệu của mình lấy từ 02 nguồn khác nhau nên tên công ty trong sheet 1 và sheet 2 là không đồng nhất. Nhưng vẫn dò tìm trong chuỗi đễ nhóm lại sự giống nhau. Ví dụ: Công Ty TNHH Quốc Tế Unilever Việt Nam và CTY UNILEVER vẫn giồng nhau ở chữ UNILEVER...)

Mong các bạn xem hộ.

Thân.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
20
Đọc
322
shnhatha221108
S
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
1
Đọc
27
ptm0412
ptm0412
K
Vẽ biểu đồ ứng suất bản thân và ứng suất gây lún = Excel
    • Thích
Trả lời
5
Đọc
13K
ptm0412
ptm0412
M
Bảng Pivot ko tự update theo dữ liệu và còn cộng thiếu số liệu.
Trả lời
6
Đọc
58
ptm0412
ptm0412
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2
Trả lời
36
Đọc
470
hoangtran1176
hoangtran1176
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom