Tìm và trích xuất dữ liệu (1 người xem)

[hungdiep85]

Chào các Thầy


Nếu ở Sheet2 Cột A có dòng nào có giá trị bằng với Sheet1 A1, thì sẽ trích xuất dữ liệu của dòng có giá trị bằng với Sheet1 A1 qua Sheet1.


Em cảm ơn các Thầy

 

[SA_DQ]

Chào các Thầy

Nếu Sheet2 Cột A có giá trị bằng với Sheet1 A1 thì sẽ trích xuất dữ liệu của Sheet2 qua Sheet1.

Em cảm ơn các Thầy

Vì mình không fải là thầy, nên sẽ không mần tiếp!
Mà có cố mần thì chưa hiểu chép dữ liệu của dòng hay chép nguyên trang?

Hẹn tuần sau gặp lại!

 

[hungdiep85]

Vì mình không fải là thầy, nên sẽ không mần tiếp!
Mà có cố mần thì chưa hiểu chép dữ liệu của dòng hay chép nguyên trang?

Hẹn tuần sau gặp lại!

Dạ, của dòng àh,
Em cảm ơn Nhiều....

 

[mhung12005]

Chào các Thầy


Nếu ở Sheet2 Cột A có dòng nào có giá trị bằng với Sheet1 A1, thì sẽ trích xuất dữ liệu của dòng có giá trị bằng với Sheet1 A1 qua Sheet1.


Em cảm ơn các Thầy

Dữ liệu của bạn chẳng có tiêu đề gì cả nên không thể dùng Advanced filter. (Mình thích Advanced filter hơn).

Thôi thì đành dùng tạm cái này vậy.

 

[hungdiep85]

Dữ liệu của bạn chẳng có tiêu đề gì cả nên không thể dùng Advanced filter. (Mình thích Advanced filter hơn).

Thôi thì đành dùng tạm cái này vậy.

Ah cái này đúng ý em luôn rùi đó Thầy, Em cảm ơn nhiều àh.

Ah nếu Dữ liệu có tiêu đề như file em mới up thì Advanced filter như thế nào vậy Thầy.

Em cảm ơn nhiều àh.

 

[mhung12005]

Ah cái này đúng ý em luôn rùi đó Thầy, Em cảm ơn nhiều àh.

Ah nếu Dữ liệu có tiêu đề như file em mới up thì Advanced filter như thế nào vậy Thầy.

Em cảm ơn nhiều àh.

Advanced filter thì thế này. Có điều nó chạy "bốc hơn" code cũ.

 

[hungdiep85]

Advanced filter thì thế này. Có điều nó chạy "bốc hơn" code cũ.

Dạ, Hình như 2 file giống nhau qua em không tìm thấy điểm khác nhau giữa(Advanced filter)

Hihihi

 

[mhung12005]

Dạ, Hình như 2 file giống nhau qua em không tìm thấy điểm khác nhau giữa(Advanced filter)

Hihihi

Với dữ liệu ít thì bạn không nhận thấy nhưng dữ liệu nhiều (vài chục ngàn dòng) sẽ thấy khác ngay )

 

[maytinhvp01]

Dạ, Hình như 2 file giống nhau qua em không tìm thấy điểm khác nhau giữa(Advanced filter)

Hihihi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cn As Object
Dim rs As Object
Dim spath As String
Dim mysql As String
Dim dk As String
If Target.Address = "$A$1" Then
Set cn = CreateObject("ADODB.connection")
Set rs = CreateObject("ADODB.recordset")
spath = ThisWorkbook.FullName
dk = Worksheets("sheet1").Cells(1, 1)
With cn
    .connectionstring = "provider=microsoft.ACE.OLEDB.12.0;data source=" & spath & ";extended properties=""excel 12.0;HDR=No;IMEX=1;"";"
    .Open
    mysql = "SELECT * FROM [sheet2$A1:J12] WHERE f1 =" & "'" & dk & "'"
    'rs.Open "SELECT * FROM [sheet2$]", cn, 3, 3
    rs.Open mysql, cn, 3, 3
    Worksheets("sheet1").Cells(3, 1).CopyFromRecordset rs
End With
End If
End Sub

copy code vao sheet1 rùi thử nhé. Mình dùng ADO và SQL cho máu. Thay đổi điều kiện tại A1 của sheet1 dư liệu chay theo

 

[Quang_Hải]

Bài tập lọc dữ liệu này cần gì dùng đao to thế. Mình thì thích xài dao nho nhỏ là đủ

Sub loc()
Application.ScreenUpdating = False
Dim RangetoFil As Range
Sheet1.[A3:J1000].ClearContents
With Sheet2
    If .[A1] <> "" Then .[A1].EntireRow.Insert
    Set RangetoFil = .Range(.[A1], .[J65536].End(3))
End With
With RangetoFil
    .AutoFilter 1, Sheet1.[A1]
    .SpecialCells(2).Copy
    Sheet1.[A3].PasteSpecial 3
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

 

[hungdiep85]

Bài tập lọc dữ liệu này cần gì dùng đao to thế. Mình thì thích xài dao nho nhỏ là đủ

Sub loc()
Application.ScreenUpdating = False
Dim RangetoFil As Range
Sheet1.[A3:J1000].ClearContents
With Sheet2
    If .[A1] <> "" Then .[A1].EntireRow.Insert
    Set RangetoFil = .Range(.[A1], .[J65536].End(3))
End With
With RangetoFil
    .AutoFilter 1, Sheet1.[A1]
    .SpecialCells(2).Copy
    Sheet1.[A3].PasteSpecial 3
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

Có thể cho em thêm cái code tự chạy khi thay đổi điều kiện tại A1 không Thầy.

Em cảm ơn các Thầy rất nhiều ....

 

[Quang_Hải]

Có thể cho em thêm cái code tự chạy khi thay đổi điều kiện tại A1 không Thầy.

Em cảm ơn các Thầy rất nhiều ....

Trên diễn đàn cứ gọi anh, em, bạn là ok rồi
Copy code cho vào sheet nào muốn chạy macro khi thay đổi dữ liệu tại A1

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" Then Loc
End Sub

 

[hungdiep85]

Advanced filter thì thế này. Có điều nó chạy "bốc hơn" code cũ.

Thầy ơi có thể cho em thêm cái code khi A1 của sheet1 không có điều kiện thì không hiển thị gì hết .
Em cảm ơn nhiều àh....

 

[maytinhvp01]

Thầy ơi có thể cho em thêm cái code khi A1 của sheet1 không có điều kiện thì không hiển thị gì hết .
Em cảm ơn nhiều àh....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cn As Object
Dim rs As Object
Dim spath As String
Dim mysql As String
Dim dk As String
If Target.Address = "$A$1" Then
Worksheets("sheet1").Range("A3:J6500").ClearContents
Set cn = CreateObject("ADODB.connection")
Set rs = CreateObject("ADODB.recordset")
spath = ThisWorkbook.FullName
dk = Worksheets("sheet1").Cells(1, 1)
With cn
    .connectionstring = "provider=microsoft.ACE.OLEDB.12.0;data source=" & spath & ";extended properties=""excel 12.0;HDR=No;IMEX=1;"";"
    .Open
    mysql = "SELECT * FROM [sheet2$A1:J6500] WHERE f1 =" & "'" & dk & "'"
    'rs.Open "SELECT * FROM [sheet2$]", cn, 3, 3
    rs.Open mysql, cn, 3, 3
    Worksheets("sheet1").Cells(3, 1).CopyFromRecordset rs
End With
End If
End Sub

Vậy là quá ngon rùi nhé

 

[hungdiep85]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cn As Object
Dim rs As Object
Dim spath As String
Dim mysql As String
Dim dk As String
If Target.Address = "$A$1" Then
Worksheets("sheet1").Range("A3:J6500").ClearContents
Set cn = CreateObject("ADODB.connection")
Set rs = CreateObject("ADODB.recordset")
spath = ThisWorkbook.FullName
dk = Worksheets("sheet1").Cells(1, 1)
With cn
    .connectionstring = "provider=microsoft.ACE.OLEDB.12.0;data source=" & spath & ";extended properties=""excel 12.0;HDR=No;IMEX=1;"";"
    .Open
    mysql = "SELECT * FROM [sheet2$A1:J6500] WHERE f1 =" & "'" & dk & "'"
    'rs.Open "SELECT * FROM [sheet2$]", cn, 3, 3
    rs.Open mysql, cn, 3, 3
    Worksheets("sheet1").Cells(3, 1).CopyFromRecordset rs
End With
End If
End Sub

Vậy là quá ngon rùi nhé

Thầy ơi khi thêm dữ liệu (dòng hay cột) vào sheet2 sao sheet1 cũng hiển thị có 3 dòng àh.hihi.....code này khó quá với em.

Em cảm ơn nhiều ....

 

[maytinhvp01]

Thầy ơi khi thêm dữ liệu vào sheet2 sao sheet1 cũng hiển thị có 3 dòng àh.hihi.....code này khó quá với em.

Em cảm ơn nhiều ....

Bạn đùa hay sao chú thêm vào sheet2 thoải mái mà tới 6500 dòng theo cấu trúc của bạn

 

[hungdiep85]

Em cảm ơn Thầy nhiều ....

 

[hungdiep85]

Bạn đùa hay sao chú thêm vào sheet2 thoải mái mà tới 6500 dòng theo cấu trúc của bạn

Àhhhhh được rùi Thầy ơi.chỉ cần save lại là cập nhập được hết.
Em cảm ơn thầy nhiều lắm......

 

[maytinhvp01]

Àhhhhh được rùi Thầy ơi.chỉ cần save lại là cập nhập được hết.
Em cảm ơn thầy nhiều lắm......

Cũng đã biết tùy biến mở rộng vùng làm việc rùi đấy nhỉ! cứ thế phát huy nhé