XIN CODE VBA TÍNH THỜI GIAN TỒN BÃI

[dinhquang042000]

Kính gửi các anh chị diễn đàn,

Em có file báo cáo cần tính thời gian tồn bãi của từng dòng theo công thức ô Ki = (Ji - Ii)*24 (trong đó i là dòng thứ i)
VD tồn bãi conts ô K2 = (J2 - I2)*24 và tương tự cho các dọng tiếp theo.
Do em cần phải xử lý dữ liệu lớn (100.000 - 200000 dữ liệu) nên khi viết hàm cho từng dòng file rất nặng và khó xử lý các bước tiếp theo.
Em muốn xây dựng code VBA để tự động tính thời gian tồn bãi theo công thức và điền vào cột K theo dòng tương ứng.
Em tìm hiểu trên diễn đàn nhưng chưa thấy bài nào tương tự, Mong anh chị bớt chút thời gian hỗ trợ chỉ giáo giúp em trường hợp này.
Em xin chân thành cảm ơn

 

[HieuCD]

Kính gửi các anh chị diễn đàn,

Em có file báo cáo cần tính thời gian tồn bãi của từng dòng theo công thức ô Ki = (Ji - Ii)*24 (trong đó i là dòng thứ i)
VD tồn bãi conts ô K2 = (J2 - I2)*24 và tương tự cho các dọng tiếp theo.
Do em cần phải xử lý dữ liệu lớn (100.000 - 200000 dữ liệu) nên khi viết hàm cho từng dòng file rất nặng và khó xử lý các bước tiếp theo.
Em muốn xây dựng code VBA để tự động tính thời gian tồn bãi theo công thức và điền vào cột K theo dòng tương ứng.
Em tìm hiểu trên diễn đàn nhưng chưa thấy bài nào tương tự, Mong anh chị bớt chút thời gian hỗ trợ chỉ giáo giúp em trường hợp này.
Em xin chân thành cảm ơn

Sub ABC()
  Dim sArr(), Res() As Double, i As Long, sRow As Long
  With Sheets("Data 3")
    i = .Range("I" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("I2:J" & i).Value2
    sRow = UBound(sArr, 1)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = (sArr(i, 2) - sArr(i, 1)) * 24
    Next i
    .Range("K2").Resize(sRow) = Res
  End With
End Sub

 

[dinhquang042000]

Sub ABC()
  Dim sArr(), Res() As Double, i As Long, sRow As Long
  With Sheets("Data 3")
    i = .Range("I" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("I2:J" & i).Value2
    sRow = UBound(sArr, 1)
    ReDim Res(1 To sRow, 1 To 1)
    For i = 1 To sRow
      Res(i, 1) = (sArr(i, 2) - sArr(i, 1)) * 24
    Next i
    .Range("K2").Resize(sRow) = Res
  End With
End Sub

Dạ em cảm ơn anh nhiều ạ

 

[ThangCuAnh]

Hì hì, anh @HieuCD lại sArr()

 

[HieuCD]

Hì hì, anh @HieuCD lại sArr()

Khi dữ liệu lớn, Dim sArr() sẽ có tốc độ nhanh hơn Dim sArr

 

[ThangCuAnh]

Anh HieuCD đã chạy thử file test bên chuyện vui VBA chưa?

 

[HieuCD]

Anh HieuCD đã chạy thử file test bên chuyện vui VBA chưa?

Chưa chạy thử, mình chỉ Test trên nhiều code của mình làm, ví dụ

Sub ABC()
  Dim i&, s&, tg As Double, a
  s = 100000
  tg = Timer
  For i = 1 To s
    a = Ngaunhien(100, 20)
  Next i
  [A1] = Timer - tg ' Dim Arr()

  tg = Timer
  For i = 1 To s
    a = Ngaunhien2(100, 20)
  Next i
  [A2] = Timer - tg ' Dim Arr
End Sub
Private Function Ngaunhien(ByVal n&, ByVal K&)
      Dim Arr() As Long, Res() As Long, i&, tmp&
  If K > n Then K = n
  ReDim Arr(1 To n):  ReDim Res(1 To K)
  Randomize
  For i = 1 To K
    tmp = Int((n * Rnd) + 1)
    If Arr(tmp) = 0 Then Res(i) = tmp Else Res(i) = Arr(tmp)
    If Arr(n) = 0 Then Arr(tmp) = n Else Arr(tmp) = Arr(n)
    n = n - 1
  Next i
  Ngaunhien = Res
End Function
Private Function Ngaunhien2(ByVal n&, ByVal K&)
      Dim Arr, Res, i&, tmp&
  If K > n Then K = n
  ReDim Arr(1 To n):  ReDim Res(1 To K)
  Randomize
  For i = 1 To K
    tmp = Int((n * Rnd) + 1)
    If Arr(tmp) = 0 Then Res(i) = tmp Else Res(i) = Arr(tmp)
    If Arr(n) = 0 Then Arr(tmp) = n Else Arr(tmp) = Arr(n)
    n = n - 1
  Next i
  Ngaunhien2 = Res
End Function