Công thức excel trong câu lệnh VBA

Liên hệ QC
Cột X là gì vậy? chỉ xử lý tạm cột X
Mã:
Sub LayDulieu()
  Dim sArr(), tArr(), Res(), Dic As Object
  Dim i As Long, ik As Long, sRow As Long, eRow As Long

  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("DuLieu")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow < 4 Then Exit Sub
    tArr = .Range("A4:X" & eRow).Value
  End With
  sRow = UBound(tArr)
  ReDim Res(1 To sRow, 1 To 3)
  For i = 1 To sRow
    Dic.Item(tArr(i, 1) & "#" & tArr(i, 2)) = i
    'Dic.Item(tArr(i, 1) & "#" & tArr(i, 24)) = i
  Next i
  With Sheets("BrDau")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow > 2 Then
      sArr = .Range("B3:E" & eRow).Value
      For i = 1 To UBound(sArr)
        ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
        If ik > 0 Then Res(ik, 1) = sArr(i, 4)
      Next i
    End If
  End With
  With Sheets("BrGiua")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow > 2 Then
      sArr = .Range("B3:E" & eRow).Value
      For i = 1 To UBound(sArr)
        ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
        If ik > 0 Then Res(ik, 2) = sArr(i, 4)
      Next i
    End If
  End With
  With Sheets("BrCuoi")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow > 2 Then
      sArr = .Range("B3:E" & eRow).Value
      For i = 1 To UBound(sArr)
        ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
        If ik > 0 Then Res(ik, 3) = sArr(i, 4)
      Next i
    End If
  End With
  With Sheets("DuLieu")
    .Range("C4:E4").Resize(sRow) = Res
  End With
'****
  ReDim Res(1 To sRow, 1 To 16)
  With Sheets("SoBinh")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow > 2 Then
      sArr = .Range("B3:E" & eRow).Value
      For i = 1 To UBound(sArr)
        ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
        If ik > 0 Then Res(ik, sArr(i, 4)) = sArr(i, 2)
      Next i
    End If
  End With
  With Sheets("DuLieu")
    .Range("H4:W4").Resize(sRow) = Res
  End With
'****
  ReDim Res(1 To sRow, 1 To 6)
  With Sheets("DichDu")
    eRow = .Range("B1000000").End(xlUp).Row
    If eRow > 2 Then
      sArr = .Range("B3:G" & eRow).Value
      For i = 1 To UBound(sArr)
        ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
        If ik > 0 Then
          Res(ik, 2 * sArr(i, 6) - 1) = sArr(i, 4)
          Res(ik, 2 * sArr(i, 6)) = sArr(i, 5)
        End If
      Next i
    End If
  End With
  With Sheets("DuLieu")
    .Range("Y4:AD4").Resize(sRow) = Res
  End With
End Sub
cột X là cột tự điền a, hoặc là chọn nó có dạng D1, D2, ..., D48
Nó sẽ bắt dữ liệu từ sheet "DichDu"
Gán D đằng trước các số tại cột vị trí thùng gom trong sheet "DichDu"
 
Bạn kiểm tra lại kết quả liên quan cột X
"Thỉnh thoảng" là như thế nào, cùng 1 file lúc bị lúc không hay khác file? Nó báo không tìm thấy sheet BrDau
Cùng 1 file anh à. Cho e hỏi chút : khi 1 máy tính khác mở file nhập liệu, thì ta chạy lệnh của a ở trên có bị lỗi gì không a???
 
Web KT
Back
Top Bottom