Code dò tìm lấy kết quả từ sheet Data sang Sheet Chuyen (1 người xem)

[lhthai]

Chào các Anh
Mình học trên diễn đàn lấy code về áp dụng cho file nhưng thấy dài
Các anh có thể viết ngắn gọn để dễ chỉnh sữa.
Code của mình giống như hàm Vlookup lấy dữ liệu từ Sheet Data trả kết quả tại sheet chuyen

Private Sub CommandButton21_Click()
Dim Arr(), i As Long, Rng As Range
   With Sheet1
      Arr = .Range("F10", .[F65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 9) = Rng.Offset(, 5)
         End If
   Next
   Sheet1.[F10].Resize(i - 1, 9) = Arr
   With Sheet1
      Arr = .Range("F10", .[F65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 13) = Rng.Offset(, 6)
         End If
   Next
   Sheet1.[F10].Resize(i - 1, 13) = Arr
   With Sheet1
      Arr = .Range("AB10", .[AB65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 9) = Rng.Offset(, 5)
         End If
   Next
   Sheet1.[AB10].Resize(i - 1, 9) = Arr
   With Sheet1
      Arr = .Range("AB10", .[AB65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 13) = Rng.Offset(, 6)
         End If
   Next
   Sheet1.[AB10].Resize(i - 1, 13) = Arr
End Sub

 

[comet_1701]

Chào các Anh
Mình học trên diễn đàn lấy code về áp dụng cho file nhưng thấy dài
Các anh có thể viết ngắn gọn để dễ chỉnh sữa.
Code của mình giống như hàm Vlookup lấy dữ liệu từ Sheet Data trả kết quả tại sheet chuyen

Private Sub CommandButton21_Click()
Dim Arr(), i As Long, Rng As Range
   With Sheet1
      Arr = .Range("F10", .[F65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 9) = Rng.Offset(, 5)
         End If
   Next
   Sheet1.[F10].Resize(i - 1, 9) = Arr
   With Sheet1
      Arr = .Range("F10", .[F65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 13) = Rng.Offset(, 6)
         End If
   Next
   Sheet1.[F10].Resize(i - 1, 13) = Arr
   With Sheet1
      Arr = .Range("AB10", .[AB65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 9) = Rng.Offset(, 5)
         End If
   Next
   Sheet1.[AB10].Resize(i - 1, 9) = Arr
   With Sheet1
      Arr = .Range("AB10", .[AB65536].End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 13) = Rng.Offset(, 6)
         End If
   Next
   Sheet1.[AB10].Resize(i - 1, 13) = Arr
End Sub

Vừa roài thấy bạn viết hăng lắm , mình nghĩ bạn sửa lại được cơ
Bạn thử đoạn này xem sao

Sub Lhthai()
Dim Arr(), i As Long, Rng As Range
   With Sheet1
      Arr = .Range("F10", .[F65536].End(3)).Resize(, 39).Value2
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 9) = Rng.Offset(, 5)
            Arr(i, 13) = Rng.Offset(, 6)
      End If
   Next
  
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 24), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, 31) = Rng.Offset(, 5)
         
            Arr(i, 35) = Rng.Offset(, 6)
      End If
   Next
   [F10].Resize(i - 1, 39).Value = Arr
End Sub

 

[VetMini]

Tôi chỉnh cho bạn theo theo yêu cầu "dễ chỉnh sửa". Tức là tránh lặp lại code, chứ không hẳn là gọn. Bởi vị cách viết của bạn đối với tôi chẳng gọn chút nào.

Private Sub CommandButton21_Click()
Dim Arr(), i As Long, Rng As Range
Dim vung as variant, cot as variant
For each vung in [ { "F", "AB" } ]
 For Each cot in array( array(9,5), array(13,6) )
   With Sheet1
      Arr = .Range(vung & "10", .Range(vung & "65536").End(3)).Resize(, 17).Formula
   End With
   For i = 1 To UBound(Arr)
      Set Rng = Sheet6.[A:A].Find(Arr(i, 2), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(i, cot(0)) = Rng.Offset(, cot(1))
         End If
   Next
   Sheet1.Range(vung & "10").Resize(i - 1, cot(0)) = Arr
 Next cot
Next vung
End Sub