Xin code VBA lấy thông tin từ file khác theo điều kiện (2 người xem)

[be_09]

Cảm ơn bạn đã quan tâm. Vấn đề là mình không muốn chỉnh sửa file “phieu_thu” ạ, vì mỗi tháng ví trí sẽ là khác nhau do thêm/bớt các khoản thu. Có cách nào để tự động xác định được vùng cần lấy mà không phải sửa file “phieu_thu”.

Chỉ còn nước kiểm tra File, nếu phiếu có 25 dòng sử dụng File 1, phiếu có 27 dòng sử dụng File 2.
File 2 thì thiết kế bổ sung rồi nhờ HieuCD thêm code lấy thêm Tiền ăn và Tiền Học thứ 7.

 

[HieuCD]

Cảm ơn anh Hiếu đã quan tâm giúp đỡ. Với code này rất đúng ý muốn của em. Tuy nhiên, khi chạy với file “phieu_thu” ở trên thì ra kết quả đúng, nhưng em thử với file “phieu_thu1” (gửi kèm theo) thì không còn chính xác nữa ạ. Nhờ anh xem giúp em với ạ.

Tìm từ "Họ tên bé" trong phiếu thu

Sub TongHop()
Dim Path As String, FileName As String
Dim Wb As Workbook
Dim sArr(), Res()
Dim ten As String, HoTen As String, lop As String
Dim i As Long, ik As Long, j As Byte, n As Byte
HoTen = "H" & ChrW(7885) & " t" & ChrW(234) & "n bé"
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  
  Path = ThisWorkbook.Path
  FileName = GetFile(ThisWorkbook.Path)
  If FileName = Empty Then MsgBox ("Chua Chon File"): GoTo Thoat
  Set Wb = Workbooks.Open(FileName)
  i = Wb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
  If i > 10 Then sArr = Wb.ActiveSheet.Range("A1:O" & i).Value
  Wb.Close False
  Set Wb = Nothing
  
  If i < 11 Then MsgBox ("File khong co du lieu"): GoTo Thoat

  ReDim Res(1 To (UBound(sArr) * 6) \ 20 + 2, 1 To 6)
  For i = 1 To UBound(sArr)
    If InStr(sArr(i, 1), HoTen) Then
      For j = 1 To 9 Step 8
        ten = sArr(i, j)
        lop = sArr(i + 1, j)
        If Len(ten) > 11 And Len(lop) > 5 Then
          k = k + 1
          ik = (k - 1) * 3 + 1
          Res(ik, 1) = k
          Res(ik, 3) = Mid(ten, 12, Len(ten))
          Res(ik, 4) = Mid(lop, 6, Len(lop))
          For n = 0 To 2
            Res(ik + n, 5) = sArr(i + n + 6, j + 1)
            Res(ik + n, 6) = sArr(i + n + 6, j + 6)
          Next n
        End If
      Next j
    End If
  Next i
  With Sheets("Sheet1")
    i = .Range("E" & Rows.Count).End(xlUp).Row
    If i > 1 Then .Range("A2:F" & i).Clear
    If ik Then
      .Range("A2:F2").Resize(ik + 2) = Res
      .Range("A2:F2").Resize(ik + 2).Borders.LineStyle = 1
    End If
  End With
Thoat:
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub