Giúp Lọc dữ liệu, đưa kết quả trùng duyệt được ở file khác về 1 Cell = VBA (1 người xem)

[congkien2610]

finish. cuối cùng mình đã tìm ra cách

 

[ThuNghi]

Nhờ các bác viết giùm code VBA để chạy 2 file giùm em.
duyệt các cell ở cột mã số nếu thấy cell nào trùng với mã mình đang tìm thì chiếu sang cột chi tiết và đưa tất cả kết quả về 1 cell
Hiện tại đang chạy bằng Hàm, vì làm việc với quá nhiều số liệu nên mỗi khi chỉnh sửa số liệu thì file chạy rất nặng và CHẬM

(Cám ơn bác ndu96081631 đã giúp em 2 file này, em đã có sửa đổi lại và chạy 1 thời gian rất tốt.)

Dồn 2 file ViTri và yeucau vào 1 có được không? Nếu OK mình làm cho. Làm ở 2 file thì mất công một ít.

 

[congkien2610]

Dồn 2 file ViTri và yeucau vào 1 có được không? Nếu OK mình làm cho. Làm ở 2 file thì mất công một ít.

Không dồn 2 file lại được đâu, vì tính chất công việc phải tách 2 file ra như vậy mà.

 

[ThuNghi]

Không dồn 2 file lại được đâu, vì tính chất công việc phải tách 2 file ra như vậy mà.

Tạm thời làm dồn 1 file đã, nếu tách riêng thi làm thêm 1 bước lấy data, để tôi nghiên cứu cách mới của NDU về CreateObject("OWC11.Spreadsheet") mà lấy vào array 1 file đang đóng (chưa tìm lại được). Còn không thì dùng ADO vậy.

Dim endR As Long, i As Long, j As Long, s As Long
Dim ArrVT(), ArrKQ(), ArrCode(), Arr() As String
Dim Vitri As String, MyStr As String
Sub LayViTri()
With Application
  .ScreenUpdating = False
End With
With Sheets("ViTri")
  endR = .Cells(65000, 3).End(xlUp).Row
  ArrVT = .Range("C3:G" & endR).Value
End With
With Sheets("YeuCau")
  endR = .Cells(65000, 4).End(xlUp).Row
  ArrCode = .Range("D7:D" & endR).Value
  .Range("C7:C1000").ClearContents
End With
ReDim ArrKQ(1 To UBound(ArrCode), 1 To 1)
For i = 1 To UBound(ArrCode)
  MyStr = "": s = 0
  Vitri = CStr(ArrCode(i, 1))
  For j = 1 To UBound(ArrVT)
    If CStr(ArrVT(j, 1)) = Vitri Then
      s = s + 1
      ReDim Preserve Arr(1 To s)
      Arr(s) = ArrVT(j, 3) & "-" & ArrVT(j, 4) & "-" & ArrVT(j, 5) & " (" & ArrVT(j, 2) & ")"
      MyStr = Join(Arr(), ";")
    End If
  Next j
  ArrKQ(i, 1) = MyStr
Next i
With Sheets("YeuCau")
  .[C7].Resize(i - 1, 1) = ArrKQ
End With
Erase ArrVT(), ArrKQ(), ArrCode(), Arr()
With Application
  .ScreenUpdating = True
End With
End Sub

 

[congkien2610]

đây là Link bài viết cũ nè
Các bác nghiên cứu giùm em
Thanks nhiều lắm

 

[ThuNghi]

đây là Link bài viết cũ nè
Các bác nghiên cứu giùm em
Thanks nhiều lắm

Tạm thời dùng cách này, mở file lây dữ liệu và đóng lại khi chưa hiểu và vận dụng cách "OWC11.Spreadsheet"
Nhớ là file Vitri, sh có tên là vitri và file yeucau cùng 1 folder.

 

[ndu96081631]

Tạm thời dùng cách này, mở file lây dữ liệu và đóng lại khi chưa hiểu và vận dụng cách "OWC11.Spreadsheet"

Muốn dùng SpreadSheet Object thì điều kiện tiên quyết là file Source phải được lưu dưới định dạng XML
Ví dụ bạn có 2 file:
- File Source.xml là nơi chứa data (gồm nhiều sheet)
- File Target.xls là file chứa code lấy dữ liệu từ file Source.xml ---> File Target.xls này có số lượng sheet bằng với file Source.xml
Vậy code tại file Target.xls như sau:

Sub Test()
  Dim spSh, i As Long
  On Error Resume Next
  With CreateObject("OWC11.Spreadsheet")
    .XMLURL = ThisWorkbook.Path & "\Source.xml"
    For Each spSh In .Sheets
      i = i + 1
      With spSh.UsedRange
        Sheets(i).Range(.Address).Value = .Value
      End With
    Next
  End With
End Sub

Code này lấy toàn bộ dữ liệu của tất cả các sheet của file Source đặt vào Target
Nếu muốn lấy 1 sheet duy nhất nào đó (sheet tên TH3 chẳng hạn), có thể sửa lại... ví dụ:

Sub Test()
  Dim spShRng
  On Error Resume Next
  With CreateObject("OWC11.Spreadsheet")
    .XMLURL = ThisWorkbook.Path & "\Source.xml"
    Set spShRng = .Sheets("TH3").UsedRange
  End With
  ActiveSheet.Range(spShRng.Address).Value = spShRng.Value
End Sub

Một vài lưu ý khi dùng SpreadSheet:
- Dùng được thuộc tính Range, Cells, Sheets
- Dùng được Offset nhưng không dùng được Resize
- Dùng được AutoFilter nhưng không dùng được AdvancedFilter
- Dùng được Find
- Không dùng được SpecialCells
vân vân... Cái này các bạn có thể tự nghiên cứu thêm
Gữi bạn file ví dụ để tham khảo

 

[congkien2610]

khi làm việc cả 2 file đều mở.
Cám ơn các bác rất nhiều.

 

[congkien2610]

Thanks ThuNghi rất nhiều,

Tạm thời dùng cách này, mở file lây dữ liệu và đóng lại khi chưa hiểu và vận dụng cách "OWC11.Spreadsheet"
Nhớ là file Vitri, sh có tên là vitri và file yeucau cùng 1 folder.