Giúp đỡ chuyển từ công thức Index sang code VBA lấy vật tư (1 người xem)

quyenpv · 17/3/22

Hiện em đang dùng 2 Sheet "TEMP" và "Input_TBi" để lấy thông tin vật tư sau khi import vào từ phiếu xuất kho.
Em xin mô tả chi tiết cái em đang làm như sau ạ:
1. Sheet "Input_TBi" chứa thông tin mã vật tư, tên vật tư có sẵn (Cái này có thể thêm mã mới khi cần bổ sung)
2. Sheet "TEMP" em dùng để import các phiếu xuất kho lấy thông tin vào tạm tại Sheet này
Đối với 1 vật tư có thể xuất hiện nhiều lần trong 1 phiếu hoặc trong nhiều phiếu thì sẽ tương ứng với mã vật tư và lần xuất, đơn giá, thông tin phiếu xuất tại Sheet "Input_TB"
* Tại Sheet TEMP

*Tại Sheet Input_TB

Em đang dùng Name động

Mã:

Data=OFFSET(TEMP!$B$4;;;COUNTA(TEMP!$B$4:$B$1048576);9)
Loc=IF(OFFSET(DATA;;;;1)=Input_TBi!$C280;ROW(INDIRECT("1:" & ROWS(DATA)));"")

Sau đó tại Sheet "Input_TBi" lấy theo mã vật tư bằng công thức Index như sau
Từ cột H17:S17 em dùng công thức để lấy khối lượng

Mã:

=IFERROR(@INDEX(DATA;SMALL(LOC;COLUMN(A1));5);0)

Từ cột T17:AE17 em dùng công thức để lấy đơn giá

Mã:

=IFERROR(@INDEX(DATA;SMALL(LOC;COLUMN(A1));7);0)

Từ cột AH17:AS17 em dùng công thức để lấy thông tin phiếu xuất kho

Mã:

=IFERROR(INDEX($AX$1:$AX$50;MATCH(@INDEX(DATA;SMALL(LOC;COLUMN(A1));9);$AY$1:$AY$50;0));"")

Mong muốn:
Do số dòng nhiều và thay đổi, số lượng công thức kéo trải dài dẫn đến việc cập nhật số liệu hay bị treo và đứng máy. Em nhờ anh chị code chuyển giúp em từ công thức sang code vba để giảm bớt và tránh treo máy khi đang làm với ạ
Cám ơn anh chị nhiều!

quyenpv · 17/3/22

Các anh chị xem giúp em với ạ. Em cám ơn

HieuCD · 18/3/22

quyenpv đã viết:
Các anh chị xem giúp em với ạ. Em cám ơn

Nên nói rỏ yêu cầu xử lý các ô, công thức ghép lung tung rất khó đọc

quyenpv · 18/3/22

HieuCD đã viết:
Nên nói rỏ yêu cầu xử lý các ô, công thức ghép lung tung rất khó đọc

Dạ anh HieuCD em có cập nhật mô tả bên trên. Mong anh và các anh xem giúp em với ạ

HieuCD · 19/3/22

quyenpv đã viết:
Dạ anh HieuCD em có cập nhật mô tả bên trên. Mong anh và các anh xem giúp em với ạ

Giải thích kiểu nầy càng khó hiểu hơn!
Kiểm tra code viết mò

Mã:

Option Explicit
Sub ABC()
  Dim aTemp(), aVT(), arr, res(), res2(), dic As Object
  Dim sRow&, sR&, i&, c&, r&
  
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Input_TBi")
    aVT = .Range("C17", .Range("C999999").End(xlUp)).Value
  End With
  sRow = UBound(aVT)
  ReDim res(1 To sRow, 1 To 24)
  ReDim res2(1 To sRow, 1 To 12)
  On Error Resume Next 'Kiem tra Ma Vat Tu Trung Lap
  For i = 1 To sRow
    dic.Add (aVT(i, 1)), Array(0, i)
  Next i
  If Err.Number > 0 Then MsgBox ("Ma Vat Tu bi Trung! Can loai ma trung"): Exit Sub
  On Error GoTo 0
  With Sheets("TEMP")
    aTemp = .Range("B5", .Range("J999999").End(xlUp)).Value
  End With
  sR = UBound(aTemp)
  For i = 1 To sR
    If dic.exists(aTemp(i, 1)) Then
      arr = dic.Item(aTemp(i, 1))
      arr(0) = arr(0) + 1
      dic.Item(aTemp(i, 1)) = arr
      res(arr(1), arr(0)) = aTemp(i, 5)
      res2(arr(1), arr(0)) = aTemp(i, 9)
      res(arr(1), arr(0) + 12) = aTemp(i, 7)
    End If
  Next i
  With Sheets("Input_TBi")
    .Range("H17").Resize(sRow, 24) = res
    .Range("AH17").Resize(sRow, 12) = res2
  End With
End Sub

quyenpv · 19/3/22

HieuCD đã viết:

Giải thích kiểu nầy càng khó hiểu hơn!
Kiểm tra code viết mò

Mã:

Option Explicit
Sub ABC()
  Dim aTemp(), aVT(), arr, res(), res2(), dic As Object
  Dim sRow&, sR&, i&, c&, r&
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Input_TBi")
    aVT = .Range("C17", .Range("C999999").End(xlUp)).Value
  End With
  sRow = UBound(aVT)
  ReDim res(1 To sRow, 1 To 24)
  ReDim res2(1 To sRow, 1 To 12)
  On Error Resume Next 'Kiem tra Ma Vat Tu Trung Lap
  For i = 1 To sRow
    dic.Add (aVT(i, 1)), Array(0, i)
  Next i
  If Err.Number > 0 Then MsgBox ("Ma Vat Tu bi Trung! Can loai ma trung"): Exit Sub
  On Error GoTo 0
  With Sheets("TEMP")
    aTemp = .Range("B5", .Range("J999999").End(xlUp)).Value
  End With
  sR = UBound(aTemp)
  For i = 1 To sR
    If dic.exists(aTemp(i, 1)) Then
      arr = dic.Item(aTemp(i, 1))
      arr(0) = arr(0) + 1
      dic.Item(aTemp(i, 1)) = arr
      res(arr(1), arr(0)) = aTemp(i, 5)
      res2(arr(1), arr(0)) = aTemp(i, 9)
      res(arr(1), arr(0) + 12) = aTemp(i, 7)
    End If
  Next i
  With Sheets("Input_TBi")
    .Range("H17").Resize(sRow, 24) = res
    .Range("AH17").Resize(sRow, 12) = res2
  End With
End Sub

Dạ em cám ơn anh HieuCD đã giúp đỡ, em có việc giờ mới mở máy xem được ạ
Code của anh về kết quả chạy đúng rồi ạ, tuy nhiên chưa tham chiếu được bên phần phiếu xuất kho em đang dùng cột phụ tại cột AX1: AZ

Mong muốn của em như thế này ạ

HieuCD · 19/3/22

quyenpv đã viết:
Dạ em cám ơn anh HieuCD đã giúp đỡ, em có việc giờ mới mở máy xem được ạ
Code của anh về kết quả chạy đúng rồi ạ, tuy nhiên chưa tham chiếu được bên phần phiếu xuất kho em đang dùng cột phụ tại cột AX1: AZ
View attachment 273362

Mong muốn của em như thế này ạ
View attachment 273364

Cái nầy mình không thể bói quẻ bạn muốn kết quả như thế nào khi AY2, AY3 ... có dữ liệu, bạn tự chỉnh dòng lệnh
res2(arr(1), arr(0)) = aTemp(i, 9)
Thành
res2(arr(1), arr(0)) = cái gì đó

quyenpv · 19/3/22

HieuCD đã viết:
Cái nầy mình không thể bói quẻ bạn muốn kết quả như thế nào khi AY2, AY3 ... có dữ liệu, bạn tự chỉnh dòng lệnh
res2(arr(1), arr(0)) = aTemp(i, 9)
Thành
res2(arr(1), arr(0)) = cái gì đó

Dạ anh. Do khi em import phiếu xuất kho nó sẽ đổ dữ liệu danh mục vật tư vào Sheet Temp, và các số phiếu vào Cột AX1: AZ... (Bao gồm cột AX là PX1, AY là số phiếu, AZ là ngày xuất phiếu)

HieuCD · 20/3/22

quyenpv đã viết:
Dạ anh. Do khi em import phiếu xuất kho nó sẽ đổ dữ liệu danh mục vật tư vào Sheet Temp, và các số phiếu vào Cột AX1: AZ... (Bao gồm cột AX là PX1, AY là số phiếu, AZ là ngày xuất phiếu)
View attachment 273374

Thêm phiếu xuất . . .

Mã:

Sub ABC()
  Dim aTemp(), aVT(), aPX(), arr, res(), res2(), dic As Object
  Dim sRow&, sR&, i&, c&, r&
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Input_TBi")
    aVT = .Range("C17", .Range("C999999").End(xlUp)).Value
    aPX = .Range("AX1", .Range("AY999999").End(xlUp)).Value
  End With
  sRow = UBound(aVT)
  ReDim res(1 To sRow, 1 To 24)
  ReDim res2(1 To sRow, 1 To 12)
  On Error Resume Next 'Kiem tra Ma Vat Tu Trung Lap
  For i = 1 To sRow
    dic.Add (aVT(i, 1)), Array(0, i)
  Next i
  For i = 1 To UBound(aPX)
    If aPX(i, 2) <> Empty Then dic.Item(aPX(i, 2)) = aPX(i, 1)
  Next i
  If Err.Number > 0 Then MsgBox ("Ma Vat Tu bi Trung! Can loai ma trung"): Exit Sub
  On Error GoTo 0
  With Sheets("TEMP")
    aTemp = .Range("B5", .Range("J999999").End(xlUp)).Value
  End With
  sR = UBound(aTemp)
  For i = 1 To sR
    If dic.exists(aTemp(i, 1)) Then
      arr = dic.Item(aTemp(i, 1))
      arr(0) = arr(0) + 1
      dic.Item(aTemp(i, 1)) = arr
      res(arr(1), arr(0)) = aTemp(i, 5)
      res2(arr(1), arr(0)) = dic.Item(aTemp(i, 9))
      res(arr(1), arr(0) + 12) = aTemp(i, 7)
    End If
  Next i
  With Sheets("Input_TBi")
    .Range("H17").Resize(sRow, 24) = res
    .Range("AH17").Resize(sRow, 12) = res2
  End With
End Sub

quyenpv · 20/3/22

HieuCD đã viết:

Thêm phiếu xuất . . .

Mã:

Sub ABC()
  Dim aTemp(), aVT(), aPX(), arr, res(), res2(), dic As Object
  Dim sRow&, sR&, i&, c&, r&
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Input_TBi")
    aVT = .Range("C17", .Range("C999999").End(xlUp)).Value
    aPX = .Range("AX1", .Range("AY999999").End(xlUp)).Value
  End With
  sRow = UBound(aVT)
  ReDim res(1 To sRow, 1 To 24)
  ReDim res2(1 To sRow, 1 To 12)
  On Error Resume Next 'Kiem tra Ma Vat Tu Trung Lap
  For i = 1 To sRow
    dic.Add (aVT(i, 1)), Array(0, i)
  Next i
  For i = 1 To UBound(aPX)
    If aPX(i, 2) <> Empty Then dic.Item(aPX(i, 2)) = aPX(i, 1)
  Next i
  If Err.Number > 0 Then MsgBox ("Ma Vat Tu bi Trung! Can loai ma trung"): Exit Sub
  On Error GoTo 0
  With Sheets("TEMP")
    aTemp = .Range("B5", .Range("J999999").End(xlUp)).Value
  End With
  sR = UBound(aTemp)
  For i = 1 To sR
    If dic.exists(aTemp(i, 1)) Then
      arr = dic.Item(aTemp(i, 1))
      arr(0) = arr(0) + 1
      dic.Item(aTemp(i, 1)) = arr
      res(arr(1), arr(0)) = aTemp(i, 5)
      res2(arr(1), arr(0)) = dic.Item(aTemp(i, 9))
      res(arr(1), arr(0) + 12) = aTemp(i, 7)
    End If
  Next i
  With Sheets("Input_TBi")
    .Range("H17").Resize(sRow, 24) = res
    .Range("AH17").Resize(sRow, 12) = res2
  End With
End Sub

Chuẩn rồi anh ạ. Em cám ơn anh

Giúp đỡ chuyển từ công thức Index sang code VBA lấy vật tư (1 người xem)

Người dùng đang xem chủ đề này

quyenpv

Thu nhặt kiến thức

File đính kèm

quyenpv

Thu nhặt kiến thức

HieuCD

Chuyên gia GPE

quyenpv

Thu nhặt kiến thức

HieuCD

Chuyên gia GPE

quyenpv

Thu nhặt kiến thức

HieuCD

Chuyên gia GPE

quyenpv

Thu nhặt kiến thức

File đính kèm

HieuCD

Chuyên gia GPE

quyenpv

Thu nhặt kiến thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian