Nhờ Hướng dẫn cách tra cứu Tréo dữ liệu (1 người xem)

ManhHungMHNH · 10/11/12

Nhờ mọi người lập lại code tra cứu chéo dữ liệu giùm à/ Xin Cảm ơn nhiều.

ndu96081631 · 10/11/12

ManhHungMHNH đã viết:
Nhờ mọi người lập lại code tra cứu chéo dữ liệu giùm à/ Xin Cảm ơn nhiều.

Sửa code thành vầy xem:

Mã:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim rData As Range, rTarget As Range, rFind As Range
  On Error Resume Next
  With [COLOR=#ff0000]Range("D2:E21")[/COLOR]
    If Not Intersect(.Cells, Target) Is Nothing Then
      If Target.Count = 1 Then
        Set rData = [COLOR=#0000cd]Sheets("A2").Range("A2:B1000")[/COLOR]
        Application.EnableEvents = False
        Set rFind = rData.Find(Target.Value, , xlValues, xlWhole)
        If Not rFind Is Nothing Then
          If rFind.Column = rData.Column Then
            Target.Offset(, 1).Value = rFind.Offset(, 1).Value
          Else
            Target.Offset(, -1).Value = rFind.Offset(, -1).Value
          End If
        Else
          Intersect(.Cells, Target.EntireRow).ClearContents
        End If
      End If
    End If
  End With
  Application.EnableEvents = True
End Sub

Lưu ý:
- Màu đỏ là vùng hoạt động của code
- Màu xanh là vùng chứa CSDL tại sheet A2
Nếu dữ liệu thật của bạn có khác thì sửa 2 em này cho phù hợp

ManhHungMHNH · 10/11/12

Cảm ơn bạn đã hướng dẫn, nhờ bạn hướng dẫn Thêm có thể tra cứu chéo cả Sheet A1 và Sheet A2, code trên chỉ tra cứu chéo được một Sheet thôi à/ cảm ơn bạn nhiều.

ndu96081631 · 10/11/12

ManhHungMHNH đã viết:
Cảm ơn bạn đã hướng dẫn, nhờ bạn hướng dẫn Thêm có thể tra cứu chéo cả Sheet A1 và Sheet A2, code trên chỉ tra cứu chéo được một Sheet thôi à/ cảm ơn bạn nhiều.

Có 1 cái rồi giờ viết thêm 1 cái nữa đâu có gì khó ---> Lý ra bạn nên tự suy nghĩ thì hay hơn:

PHP:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim rData1 As Range, rFind1 As Range
  Dim rData2 As Range, rFind2 As Range
  On Error Resume Next
  With Range("B2:C21")
    If Not Intersect(.Cells, Target) Is Nothing Then
      If Target.Count = 1 Then
        Set rData1 = Sheets("A1").Range("A2:B1000")
        Application.EnableEvents = False
        Set rFind1 = rData1.Find(Target.Value, , xlValues, xlWhole)
        If Not rFind1 Is Nothing Then
          If rFind1.Column = rData1.Column Then
            Target.Offset(, 1).Value = rFind1.Offset(, 1).Value
          Else
            Target.Offset(, -1).Value = rFind1.Offset(, -1).Value
          End If
        Else
          Intersect(.Cells, Target.EntireRow).ClearContents
        End If
      End If
    End If
  End With
  With Range("D2:E21")
    If Not Intersect(.Cells, Target) Is Nothing Then
      If Target.Count = 1 Then
        Set rData2 = Sheets("A2").Range("A2:B1000")
        Application.EnableEvents = False
        Set rFind2 = rData2.Find(Target.Value, , xlValues, xlWhole)
        If Not rFind2 Is Nothing Then
          If rFind2.Column = rData2.Column Then
            Target.Offset(, 1).Value = rFind2.Offset(, 1).Value
          Else
            Target.Offset(, -1).Value = rFind2.Offset(, -1).Value
          End If
        Else
          Intersect(.Cells, Target.EntireRow).ClearContents
        End If
      End If
    End If
  End With
  Application.EnableEvents = True
End Sub

Code này đúng ra có thể rút gọn lại rất nhiều nhưng tôi vẫn viết rõ ràng ra 2 trường hợp thế cho bạn dễ tiếp thu

sealand · 10/11/12

Dài quá Ndu ơi, mình thấy thế này cũng được:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Thoat
Application.EnableEvents = False
Dim SName As String
If Not Intersect(Sheet2.[B2:B100], Target) Is Nothing Or _
Not Intersect(Sheet2.[D2:D100], Target) Is Nothing Then
SName = IIf(Target.Column = 2, "A1", "A2")
Target.Offset(, 1).Value = _
Worksheets(SName).[A2:A1000].Find(Target.Value, , xlValues, xlWhole).Offset(, 1).Value
End If
Thoat:
Application.EnableEvents = True
End Sub

Chú ý: Bạn sửa tiêu đề 1 chút : Tréo -->chéo

ndu96081631 · 10/11/12

sealand đã viết:
Dài quá Ndu ơi, mình thấy thế này cũng được:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Thoat Application.EnableEvents = False Dim SName As String If Not Intersect(Sheet2.[B2:B100], Target) Is Nothing Or _ Not Intersect(Sheet2.[D2:D100], Target) Is Nothing Then SName = IIf(Target.Column = 2, "A1", "A2") Target.Offset(, 1).Value = _ Worksheets(SName).[A2:A1000].Find(Target.Value, , xlValues, xlWhole).Offset(, 1).Value End If Thoat: Application.EnableEvents = True End Sub

Chú ý: Bạn sửa tiêu đề 1 chút : Tréo -->chéo

Đâu có được anh!
Đã gọi là TRA CỨU CHÉO mà. Tức tra A, ra B và ngược lại tra B phải ra A

sealand · 10/11/12

Thực sự, đến giờ mình chưa hiểu tra kiểu gì.

ndu96081631 · 10/11/12

sealand đã viết:
Thực sự, đến giờ mình chưa hiểu tra kiểu gì.

Tức là vầy:
- Anh chọn Validation ở cột B thì cột C tự "nhảy" theo (giống như dùng VLOOKUP để tra vậy) ---> Điều này không có gì đáng nới
- Nhưng khi anh chọn Validation ở cột C thì cột B cũng phải "nhảy" theo
Thế mới gọi là tra cứu chéo chứ anh! Tóm lại: tra A thì ra B và tra B thì ra A
Vậy thôi
------------
Ứng dụng: Tra tiếng Anh, ra kết quả tiếng Việt. Ngược lại, tra tiếng Việt, ra kết quả tiếng Anh

sealand · 10/11/12

Nhưng mình vẫn chưa thấy 2 bảng này chung nhau cái gì. Hay là ký tự cuối cùng bangr A2 là mã A1.Nếu vậy thì mình sửa code thế này

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Thoat
Application.EnableEvents = False
Dim Ma1 As String, Ma2 As String
If Not Intersect(Sheet2.[B2:B100], Target) Is Nothing Or _
Not Intersect(Sheet2.[D2:D100], Target) Is Nothing Then
Ma1 = IIf(Target.Column = 2, Target.Value, Right(Trim(Target.Value), 1))
Ma2 = IIf(Target.Column = 2, "111" & Target.Value, Target.Value)
If Target.Column = 2 Then
Target.Offset(, 1).Value = _
Sheet1.[A2:A1000].Find(Target.Value, , xlValues, xlWhole).Offset(, 1).Value
Target.Offset(, 2).Value = Ma2
Target.Offset(, 3).Value = _
Sheet3.[A2:A1000].Find(Ma2, , xlValues, xlWhole).Offset(, 1).Value
Else
Target.Offset(, 1).Value = _
Sheet3.[A2:A1000].Find(Target.Value, , xlValues, xlWhole).Offset(, 1).Value
Target.Offset(, -2).Value = Ma1
Target.Offset(, -1).Value = _
Sheet1.[A2:A1000].Find(Ma1, , xlValues, xlWhole).Offset(, 1).Value
End If
End If
Thoat:
Application.EnableEvents = True
End Sub

sealand · 11/11/12

Xem xong bóng đá mà vẫn phân vân, vậy thì tại sao không làm cứ chọn 1 ô trong 4 cột thì tra tiếp ô còn lại. Thử xem sao

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Thoat
Application.EnableEvents = False
Dim Kq(): ReDim Kq(1 To 4)
If Not Intersect(Sheet2.[B2:E100], Target) Is Nothing Then
If Target.Column = 2 Then
Kq(1) = Target.Value
ElseIf Target.Column = 3 Then
Kq(1) = Sheet1.[B2:B1000].Find(Target.Value, , xlValues, xlWhole).Offset(, -1).Value
ElseIf Target.Column = 4 Then
Kq(1) = Right(Trim(Target.Value), 1)
ElseIf Target.Column = 5 Then
Kq(1) = Right(Trim(Sheet3.[B2:B1000].Find(Target.Value, , xlValues, xlWhole).Offset(, -1).Value), 1)
End If
Kq(2) = Sheet1.[A2:A1000].Find(Kq(1), , xlValues, xlWhole).Offset(, 1).Value
Kq(3) = "111" & Kq(1)
Kq(4) = Sheet3.[A2:A1000].Find(Kq(3), , xlValues, xlWhole).Offset(, 1).Value
Sheet2.Cells(Target.Row, 2).Resize(, 4) = Kq
End If
Thoat:
Application.EnableEvents = True
End Sub

ndu96081631 · 11/11/12

sealand đã viết:

Xem xong bóng đá mà vẫn phân vân, vậy thì tại sao không làm cứ chọn 1 ô trong 4 cột thì tra tiếp ô còn lại. Thử xem sao

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Thoat
Application.EnableEvents = False
Dim Kq(): ReDim Kq(1 To 4)
If Not Intersect(Sheet2.[B2:E100], Target) Is Nothing Then
If Target.Column = 2 Then
Kq(1) = Target.Value
ElseIf Target.Column = 3 Then
Kq(1) = Sheet1.[B2:B1000].Find(Target.Value, , xlValues, xlWhole).Offset(, -1).Value
ElseIf Target.Column = 4 Then
Kq(1) = Right(Trim(Target.Value), 1)
ElseIf Target.Column = 5 Then
Kq(1) = Right(Trim(Sheet3.[B2:B1000].Find(Target.Value, , xlValues, xlWhole).Offset(, -1).Value), 1)
End If
Kq(2) = Sheet1.[A2:A1000].Find(Kq(1), , xlValues, xlWhole).Offset(, 1).Value
Kq(3) = "111" & Kq(1)
Kq(4) = Sheet3.[A2:A1000].Find(Kq(3), , xlValues, xlWhole).Offset(, 1).Value
Sheet2.Cells(Target.Row, 2).Resize(, 4) = Kq
End If
Thoat:
Application.EnableEvents = True
End Sub

Không phải đâu anh à! Hai bảng màu xanh và màu vàng là tách biệt hoàn toàn. Bảng màu xanh tra cứu tại sheet A1, bảng màu vàng tra cứu tại sheet A2
Nó đơn giản thôi mà, không hiểu sao anh sealand lại phân vân nhỉ?

Nhờ Hướng dẫn cách tra cứu Tréo dữ liệu (1 người xem)

Người dùng đang xem chủ đề này

ManhHungMHNH

Thành viên chính thức

File đính kèm

ndu96081631

Huyền thoại GPE

ManhHungMHNH

Thành viên chính thức

ndu96081631

Huyền thoại GPE

sealand

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

ndu96081631

Huyền thoại GPE

sealand

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

ndu96081631

Huyền thoại GPE

sealand

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

File đính kèm

sealand

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

File đính kèm

ndu96081631

Huyền thoại GPE

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

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

Đếm ngược thời gian