Tìm kiếm dữ liệu trên nhiều sheet (1 người xem)

[takashio]

Hi all !
Mình muốn tìm dữ liệu trên nhiều sheet mà mình chưa biết phải làm như thế nào ? Mọi người xem giúp mình nhé!

 

[ThuNghi]

Hi all !
Mình muốn tìm dữ liệu trên nhiều sheet mà mình chưa biết phải làm như thế nào ? Mọi người xem giúp mình nhé!

Dùng thử code này xem

Dim endR As Long, i As Long, j As Long
Dim ArrData(), ArrFind(), ArrKQ
Dim shName As String, sMa As String
Dim sh As Worksheet
Sub TimKiem()
With Sheets("Main")
  endR = .Cells(65000, 10).End(xlUp).Row
  If endR = 14 Then Exit Sub
  ArrFind = .Range("J15:J" & endR).Value
End With
ReDim ArrKQ(1 To UBound(ArrFind), 1 To 1)
For Each sh In ThisWorkbook.Worksheets
  shName = sh.Name
  If Left(shName, 2) = "Pa" Then
    With sh
      endR = .Cells(65000, 2).End(xlUp).Row
      If endR = 10 Then GoTo next_sh
      ArrData = .Range("B11:C" & endR)
      For i = 1 To UBound(ArrFind)
        sMa = ArrFind(i, 1)
        For j = 1 To UBound(ArrData)
          If ArrData(j, 1) = sMa Then
            ArrKQ(i, 1) = ArrData(j, 2)
            
          End If
        Next j
      Next i
    End With
  End If
next_sh:
Next sh
With Sheets("Main")
  .[N15].Resize(i - 1, 1) = ArrKQ
End With
Erase ArrData(), ArrFind(), ArrKQ
End Sub

 

[takashio]

Mình cám ơn bạn nhé ! Code chạy rất tốt nhưng nếu khi mình thêm sheet sản phẩm thì lại không tìm kiếm được ( thêm sheets mới có cùng kiểu cấu trúc với các sheet sản phẩm khác ). Bạn có thể xem thêm giúp mình được không.

 

[Hai Lúa Miền Tây]

Code sau sẽ có 2 vòng lặp:

Private Sub TimKiem_Click()
 Dim ws As Worksheet
 Dim rFound, rCell As Range
    
 On Error Resume Next
 Application.ScreenUpdating = False
 
 For Each rCell In Sheet1.Range("J15:J19")
    For Each ws In Worksheets
      If ws.Name <> "Main" Then
        With ws.UsedRange
           Set rFound = .Find(What:=rCell.Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
            If Not rFound Is Nothing Then
               Application.Goto rFound, True
               rCell.Offset(, 4) = rFound.Offset(, 1).Value
            End If
        End With
       End If
    Next ws
 Next
 Sheet1.Select
 Application.ScreenUpdating = True

End Sub

 

[ThuNghi]

Mình cám ơn bạn nhé ! Code chạy rất tốt nhưng nếu khi mình thêm sheet sản phẩm thì lại không tìm kiếm được ( thêm sheets mới có cùng kiểu cấu trúc với các sheet sản phẩm khác ). Bạn có thể xem thêm giúp mình được không.

Vậy sh mới có tên là gì.

If Left(shName, 2) = "Pa" Then

Hiện tại chỉ tìm trong những sh mà có Pa, bạn có thể triển khai.
Nếu tên sh kg có gì chung thì nên có 1 array tên sh cần lấy.

 

[takashio]

Mình cám ơn bạn ThuNghi , domfootwear và mọi người nhé . Bạn domfootwear làm đúng ý của mình rùi ạ.

Mình muốn tìm kiếm sản phẩm không dùng tên sheet ,chỉ dựa vào bảng trên từng sheets. Mình thấy khó thế mà các bạn lại làm được nhanh thế ! Không biết đến bao giờ mình mới được như các bạn.

 

[Excel365]

Dùng thử code này xem

Dim endR As Long, i As Long, j As Long
Dim ArrData(), ArrFind(), ArrKQ
Dim shName As String, sMa As String
Dim sh As Worksheet
Sub TimKiem()
With Sheets("Main")
  endR = .Cells(65000, 10).End(xlUp).Row
  If endR = 14 Then Exit Sub
  ArrFind = .Range("J15:J" & endR).Value
End With
ReDim ArrKQ(1 To UBound(ArrFind), 1 To 1)
For Each sh In ThisWorkbook.Worksheets
  shName = sh.Name
  If Left(shName, 2) = "Pa" Then
    With sh
      endR = .Cells(65000, 2).End(xlUp).Row
      If endR = 10 Then GoTo next_sh
      ArrData = .Range("B11:C" & endR)
      For i = 1 To UBound(ArrFind)
        sMa = ArrFind(i, 1)
        For j = 1 To UBound(ArrData)
          If ArrData(j, 1) = sMa Then
            ArrKQ(i, 1) = ArrData(j, 2)
            
          End If
        Next j
      Next i
    End With
  End If
next_sh:
Next sh
With Sheets("Main")
  .[N15].Resize(i - 1, 1) = ArrKQ
End With
Erase ArrData(), ArrFind(), ArrKQ
End Sub

Code này thì hơi dài so với code của anh Hai Lúa Miền Tây, nhưng xét về tốc độ thì rất là nhanh