Cần trợ giúp tìm dữ liệu bằng VBA

[moixemne]

Chào mấy bác:
em có 1 file lưu thông tin về phương tiện vận tải do mình quản lí
trong sheet 1 là toàn bộ thông tin
em muốn trong sheet 2 khi nhập thông tin của 1 trong các ô em tô màu vàng thì nó sẽ hiện ra toàn bộ thông tin của con tàu đó, trong sheet 3 thì khi em nhập trọng tải hoặc VRH (vd: 100tấn - 500tấn, ô VRH thì nhập 0 or 1 or 2 or 3; ) thì nó sẽ hiện ra tất cả thông tin các tàu thỏa mãn điều kiện trong đó và sheet 2, sheet 3 chỉ đựơc xem kết quả ko được sữa thông tin, nhưng vẫn cho coppy
em biết đòi hỏi hơi nhiều nhưng mong mấy bác giúp đỡ em với
cái này em rất cần bay giờ em chỉ gửi vd thôi vì danh sách của em gần 4000 con tàu
mổi lần tìm là em đau hết cả đầu
em thì dân kĩ thuật nên ngu mấy cái này lắm
cám ơn mấy bác nhiều
do file này nhiều người sữ dụng nên dùng công thức ko được
sau 1 thời gian sẽ mất công thức và lổi do sơ suất của người sử dụng

 

[hoa35ktxd]

Cái này đơn giản thôi mà, trước tiên bạn phải định dạng dữ liệu theo chuẩn nhất định bao gồm nhiều cột, một cột chứa 1 thông tin của con tàu trong đó có 1 cột chứa mã hiệu, số liệu nhập vào cột mã hiệu phải là duy nhất để tránh nhầm lẫn.
Sau đó bạn dùng vòng lặp để duyệt trên cột chứa thông tin cần nhập, nếu trùng thì cho ra kết quả của các cột kia.
Nếu bạn biết làm việc với Cơ sở dữ liệu thì có nhiều giao thức hiện đại, tiện dụng hơn như DAO, JET, ADO... dùng câu lệnh truy vấn SELCT CacCotCanTim FROM Bang, Where Cot = "ABC..."
Đại khái thế
Còn cụ thể thì bạn có thể tham khảo đoạn mã sau
Đưa sự kiện này vào ThisWorkbook nhé.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Cls As Integer, CrR As Integer, J As Integer
    Dim I As Long
    Cls = ActiveCell.Column
    CrR = ActiveCell.Row
    If ActiveSheet.Index <> 2 Then Exit Sub
    If InStr("2,4,12,13,19,21,22", Cls) <> 0 Then
        With Sheets(2)
            Sheets(1).Select
            For I = 3 To ActiveCell.SpecialCells(xlLastCell).Row
                If Cells(I, Cls).Value = .Cells(CrR - 1, Cls).Value Then
                    For J = 1 To 26
                        .Cells(CrR, J).Value = Cells(I, J).Value
                    Next
                    CrR = CrR + 1
                End If
            Next
            .Select
        End With
    End If
End Sub

Đoạn mã này chỉ làm việc trên Sheet 2, sang sheet khác bạn là tương tự
Lưu ý: File dữ liệu của bạn không được sử dụng chức năng Merge Cell theo chiều dọc sẽ dẫn đến lẫn cột, hãy thay thế bằng định dạng Center Across Selection.

 

[ChanhTQ@]

Bạn xem thử trong file đính kèm & cho í kiến nha!

Option Explicit

Private Sub Worksheet_Activate()
    Auto_Run
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [b2]) Is Nothing Then
    Dim Rng As Range, sRng As Range
    With Sheets("Goc")
        Set Rng = .Range(.[b3], .[B65500].End(xlUp))
        Set sRng = Rng.Find(what:=Target, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not sRng Is Nothing Then
            [A2] = sRng.Offset(, -1).Value:         [c2] = sRng.Offset(, 2).Value
            [D2] = sRng.Offset(, 10).Value:         [E2] = sRng.Offset(, 11).Value
            [F2] = sRng.Offset(, 17).Value:         [G2] = sRng.Offset(, 19).Value
            [H2] = sRng.Offset(, 20).Value
        End If
    End With
 
 End If
End Sub

'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - '

Option Explicit
Dim lRw As Long
Sub Auto_Run()
  lRw = Sheets("goc").[B65500].End(xlUp).Row
  ActiveWorkbook.Names.Add Name:="DSTau", RefersToR1C1:="=goc!R3C2:R" & lRw & "C2"
End Sub

 

[moixemne]

Cám ơn bác Hoa35ktxd và ChanhTQ@ nhưng của 2 bạn cũng như là filter
ở đây ý mình muốn là mình tìm 1 cái nó sẽ ra hàng loạt tàu thỏa mãn điều kiện luôn
VD: ô VRH mình nhập là 1 thì sẽ ra tất cả tàu có VRH = 1
hoặc mình nhập trọng tải là 100 tấn đến 300 tấn thì nó sẽ ra tất cả các tàu nằm trong khoảng đó
tất cả thông tin tàu sẽ hiện ra như bên sheet 1

 

[hoa35ktxd]

Đoạn code trên đúng theo yêu cầu của bạn
Có lẽ bạn không hiểu đoạn code đó nên không biết sử dụng
Hãy tải file tôi gửi kèm sau đây nhé
Lưu ý: Bạn muốn tìn dữ liệu ở cột nào trên Sheets(1) thì bạn phải nhập vào ở cột tương ứng đó trên Sheets(2)
Đây là đoạn mã đơn giản thôi, chưa có tính chuyên nghiệp, thường thì dạng này nên tạo Form truy vấn sẽ đẹp hơn.
Thân.

 

[SA_DQ]

Đoạn code trên đúng theo yêu cầu của bạn
Có lẽ bạn không hiểu đoạn code đó nên không biết sử dụng
Lưu ý: Bạn muốn tìn dữ liệu ở cột nào trên Sheets(1) thì bạn phải nhập vào ở cột tương ứng đó trên Sheets(2)

Khó xài vì không có tính trực quang; Chỉ 1 trường [CapTau] là dễ xài mà thôi

Xin mới các bạn xem cách xài với ComboBox trong file đính kèm

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range, rRng As Range
 Dim MyAdd As String
 Dim Jj As Long
 
 Application.ScreenUpdating = False
 
 With Sheets("Goc")
    If Not Intersect(Target, [B2]) Is Nothing Then
        Set Rng = .Range(.[B3], .[B65500].End(xlUp))
        Set sRng = Rng.Find(what:=Target, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not sRng Is Nothing Then
            [A3] = sRng.Offset(, -1).Value:         [c3] = sRng.Offset(, 2).Value
            [D3] = sRng.Offset(, 4).Value:         [E3] = sRng.Offset(, 5).Value
            [F3] = sRng.Offset(, 6).Value:         [G3] = sRng.Offset(, 7).Value
            [H3] = sRng.Offset(, 8).Value:         [B3] = [B2]
        End If
        Range("A4").Resize(99, 8).Clear
    ElseIf Not Intersect(Target, [c2]) Is Nothing Then
        Set Rng = .Range(.[c3], .[c65500].End(xlUp))
        TimKiem Rng, Target.Value
    ElseIf Not Intersect(Target, [D2]) Is Nothing Then
        Set Rng = .Range(.[D3], .[D65500].End(xlUp))
        TimKiem Rng, Target.Value
    ElseIf Not Intersect(Target, [E2]) Is Nothing Then
        Set Rng = .Range(.[E3], .[E65500].End(xlUp))
        TimKiem Rng, Target.Value
    ElseIf Not Intersect(Target, [F2]) Is Nothing Then
        Set Rng = .Range(.[F3], .[F65500].End(xlUp))
        TimKiem Rng, Target.Value
    ElseIf Not Intersect(Target, [G2]) Is Nothing Then
        Set Rng = .Range(.[G3], .[G65500].End(xlUp))
        TimKiem Rng, Target.Value
    ElseIf Not Intersect(Target, [H2]) Is Nothing Then
        Set Rng = .Range(.[H3], .[H65500].End(xlUp))
        TimKiem Rng, Target.Value
    
    End If
 End With
End Sub

[B]Sub TimKiem(Rng As Range, What_ As Variant)[/B]
 Dim sRng As Range, rRng As Range:          Dim Sh As Worksheet
 Dim MyAdd As String:                       Dim Jj As Integer
 
 Set Sh = Sheets("Goc")
 Set sRng = Rng.Find(What_, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
    MyAdd = sRng.Address:                   Jj = 0
    Do
        If rRng Is Nothing Then
            Set rRng = Sh.Cells(sRng.Row, 1).Resize(, 8)
        Else
            Set rRng = Union(rRng, Sh.Cells(sRng.Row, 1).Resize(, 8))
        End If
        Jj = 1 + Jj
        Set sRng = Rng.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    Range("A3").Resize(Jj, 8).Value = rRng.Value
    Range("A3").Offset(Jj).Resize(99, 8).Clear
 End If
[B]End Sub[/B]

 

[moixemne]

cám ơn các bạn rất nhiều.
nhờ có các bạn mà mình học thêm được rất nhiều thứ
cho mình thắc mắc thêm 1 tí nữa
đó là làm cách nào để lọc các đối tượng trong 1 khoảng không
vd: trọng tải mình có thể tìm tất cả các tàu trong khoảng 300 - 400t ko
vì cái này cũng quan trọng lắm
nhiều khi xếp cần danh sách đó để sắp xếp hàng hóa
danh sách đầy đủ của mình đến tàu có trọng tải 40,000t được
cho nên mình ko thể nào nhập vào từng số rồi coppy được
ở đây mình muốn nhập vào 2 số và nó sẽ ra tất cả các tàu có trọng tải nằm giữa 2 số đó
mong các bạn giúp đỡ mình thêm 1 lần nữa
xin chúc các bạn vui vẻ, sức khỏe và hạnh phúc

 

[SA_DQ]

Chỉ cho mình thêm 1 tí nữa
đó là làm cách nào để lọc các đối tượng trong 1 khoảng không
vd: trọng tải mình có thể tìm tất cả các tàu trong khoảng 300 - 400t ko

Bạn mở file cuối của mình lên nha; Mình cùng bạn ta thử nghiệm phương thức AdvancedFillter;

* Chọn vo sheets("Goc"); kích hoạt các ô 'A1:I1'
* Bấm CTRL + C để Copy vùng này; Đem dán xuống 'A24' & 'A28'
* Kích hoạt ô 'H24' & copy sang ô bên phải nó;
* Bạn nhập vô ô H25:= ">=350" & ô 'I25' := "<=400" (Xong bước chuẩn bị.)
* Tô chọn vùng 'A1:I20' bằng chuột; Vô menu Data -> Filter-> Chọn dòng cuối cùng
'Advanced Filter'
(+) Trong ngăn Action ta bấm chọn nút Copy to another location
(+) Trong ngăn list Range đã có '$A$1:$I$20'
(+) Trong ngăn Crỉteiia range, nếu chưa có/chưa đúng '$H$24:$I$25' thì ta thực hiện giúp cho excel
(+) Trong ngăn Copy to bạn nhập vô '$A$28:$I$28'
Bấm OK để thấy kết quà

Hãy lặp lại 7 lần như vậy (Ông bà mình có câu: 'Bảy lần đo, 1 lần cắt mà!')

Chỉ sau đó bạn mở bộ thu macro lên & đọc xem ra sao; (Nhưng chỉ thu giai đoạn sau bước chuản bị mà thôi!)

Chúc bạn thành công trong công việc! Nếu Sếp khen, bạn hãy nhớ đến GPE.COM với nha!

 

[hoa35ktxd]

Như từ đầu tôi đã nói, việc truy vấn cơ sở dữ liệu đã được Micosoft cung cấp rất nhiều công cụ mạnh, nhanh chóng, hiệu quả, chính xác, chuyên nghiệp. Trong đó có DAO là dơn giản nhất, code của tôi chỉ là ví dụ minh họa thôi.
Bạn hãy nghiên cứu qua một chút về DAO, có nhiều bài viết về cái này lắm.