Nhờ giúp Macro tổng hợp vật tư

Liên hệ QC

scorpion_wru

Thành viên mới
Tham gia
19/2/11
Bài viết
9
Được thích
2
Mình định tạo một Macro để tổng hợp vật tư bằng cách sử dụng chức năng Record Macro để tạo ra macro đó.
Thao tác cụ thể như trong Video đính kèm
Nhưng khi chay Macro vừa tạo thì báo lỗi
Vậy nhờ mọi người chỉ cách, hoặc sửa lỗi giúp
Thanks !
 
Mình định tạo một Macro để tổng hợp vật tư bằng cách sử dụng chức năng Record Macro để tạo ra macro đó.
Thao tác cụ thể như trong Video đính kèm
Nhưng khi chay Macro vừa tạo thì báo lỗi
Vậy nhờ mọi người chỉ cách, hoặc sửa lỗi giúp
Cảm ơn !
Bạn up cái file mẫu của bạn lên đây sẽ được giúp đỡ ngay.
 
Bạn thử theo cách này
Mã:
Sub Loc()
    Dim dic As Object, i As Long, a As Long, arr, KetQua, b As Long, DieuKien As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         arr = .Range("B6:E18").Value
         ReDim KetQua(1 To UBound(arr), 1 To 4)
         For i = 1 To UBound(arr)
             DieuKien = arr(i, 1)
             If Not dic.exists(DieuKien) Then
                a = a + 1
                dic.Add DieuKien, a
                KetQua(a, 1) = DieuKien
                KetQua(a, 4) = arr(i, 4)
             Else
                b = dic.Item(DieuKien)
                KetQua(b, 4) = KetQua(b, 4) + arr(i, 4)
             End If
         Next i
         .Range("B21:E21").Resize(a).Value = KetQua
   End With
End Sub
 

File đính kèm

  • Tổng hợp vật tư.xlsm
    17.9 KB · Đọc: 9
Bạn thử theo cách này
Mã:
Sub Loc()
    Dim dic As Object, i As Long, a As Long, arr, KetQua, b As Long, DieuKien As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
         arr = .Range("B6:E18").Value
         ReDim KetQua(1 To UBound(arr), 1 To 4)
         For i = 1 To UBound(arr)
             DieuKien = arr(i, 1)
             If Not dic.exists(DieuKien) Then
                a = a + 1
                dic.Add DieuKien, a
                KetQua(a, 1) = DieuKien
                KetQua(a, 4) = arr(i, 4)
             Else
                b = dic.Item(DieuKien)
                KetQua(b, 4) = KetQua(b, 4) + arr(i, 4)
             End If
         Next i
         .Range("B21:E21").Resize(a).Value = KetQua
   End With
End Sub
- Cảm ơn bạn rất nhiều. Đoạn code rất tốt
- Tuy nhiên, Bạn có thể chỉ mình cách nào khác mà không phải sử dụng lập trình không (Tại vì mình không biết lập trình, nên muốn tùy biến đoạn code của bạn để phù hợp với công việc thì không làm được). Chỉ mình cách nào mà sử dụng chức năng record macro để có thể mô phỏng lại các thao tác mẫu chẳng hạn.
 
- Cảm ơn bạn rất nhiều. Đoạn code rất tốt
- Tuy nhiên, Bạn có thể chỉ mình cách nào khác mà không phải sử dụng lập trình không (Tại vì mình không biết lập trình, nên muốn tùy biến đoạn code của bạn để phù hợp với công việc thì không làm được). Chỉ mình cách nào mà sử dụng chức năng record macro để có thể mô phỏng lại các thao tác mẫu chẳng hạn.
Đã vào diễn đàn rồi thì không biết Code cũng thành biết thôi mà ;););)
 
Chào mọi người,
Mình có 1 file gồm 2 sheet: 1. Sheet Giao_hàng; 2. Sheet "Thống_Kê". Mình học trên mạng đã tạo được mảng và gán được chọn mặt hàng trên phiếu giao hàng. Mình muốn mọi người giúp mình viết code VBA cho việc thống kê như sau:
1) Khi nhấn nút "Lưu đơn hàng" thì số lượng các mặt hàng trên "Phiếu Giao hàng" sẽ được lưu đúng vị trí của mặt hàng đó bên Sheet "Lưu đơn hàng".
2) Tại Sheet "Lưu đơn hàng", khi phát hiện sai sót có thể đánh dấu "X" tại đơn hàng sai đó và nhấn nút sẽ in lại được "Phiếu giao hàng" và sau khi sửa sai sẽ lại lưu vào đúng dòng của đơn hàng đó.
P/s Mình gửi file kèm theo, mong mọi người giúp đỡ....
 

File đính kèm

  • Phieu giao hang.xlsm
    18.4 KB · Đọc: 5
Chào mọi người,
Mình có 1 file gồm 2 sheet: 1. Sheet Giao_hàng; 2. Sheet "Thống_Kê". Mình học trên mạng đã tạo được mảng và gán được chọn mặt hàng trên phiếu giao hàng. Mình muốn mọi người giúp mình viết code VBA cho việc thống kê như sau:
1) Khi nhấn nút "Lưu đơn hàng" thì số lượng các mặt hàng trên "Phiếu Giao hàng" sẽ được lưu đúng vị trí của mặt hàng đó bên Sheet "Lưu đơn hàng".
2) Tại Sheet "Lưu đơn hàng", khi phát hiện sai sót có thể đánh dấu "X" tại đơn hàng sai đó và nhấn nút sẽ in lại được "Phiếu giao hàng" và sau khi sửa sai sẽ lại lưu vào đúng dòng của đơn hàng đó.
P/s Mình gửi file kèm theo, mong mọi người giúp đỡ....
THEO Ý TƯỞNG CỦA BẠN. Có sửa chữa đôi chỗ - Bạn xem File đính kèm nhé
 

File đính kèm

  • Phieu giao hang.xlsm
    47.1 KB · Đọc: 5
THEO Ý TƯỞNG CỦA BẠN. Có sửa chữa đôi chỗ - Bạn xem File đính kèm nhé
Rất cảm ơn bạn nhưng vẫn chưa đúng ý mình cần nhờ. Trong Sheet "Giao hàng" Số lượng các mặt hàng sẽ được chọn ngẫu nhiên (VD: ô C6 sẽ là mặt hàng 3, ô C7 sẽ là mặt hàng 1....) nhưng lúc lưu sang Sheet "Thống kê" thì mặt hàng nào vẫn được lưu vào đúng ô của tên hàng đấy (range("C6").value của Sheet "Giao hàng" sẽ phải được lưu vào ô tại cột H của Sheet "Thống kê".
Mong bạn sửa code giúp mình với....
P/s Mình gửi lại file mà mình đã chú dẫn ở Sheet "Thống kê" bạn nhé. Thanks.
 

File đính kèm

  • Phieu giao hang (1).xlsm
    38.6 KB · Đọc: 3
. . . Ai giúp mình cách sử dụng cái Record Macro đi
Tham khảo thêm macro này, có chỉnh sửa khá nhiều sau khi ghi macro: & tạo danh sách duy nhất của VT tại cột L, bắt đầu từ [L2]
PHP:
Sub TinhTongTheoLoai()
Dim WF As Object, Rng As Range, Cls As Range

[H5].Value = [B5].Value                'Tao Vung Criteria  '
Set Rng = Range([B5], [B5].End(xlDown)).Resize(, 4)    'Xác Dinh CSDL  '
Set WF = Application.WorksheetFunction                     '* '
For Each Cls In Range([L2], [L2].End(xlDown))      'Vòng Lap Duyet Theo Danh Sách Duy Nhât   '
    [h6].Value = Cls.Value              'Gán Tên VT Vô Vùng Criteria    '
    Cls.Offset(, 1).Value = WF.DSum(Rng, [e5], [H5:H6])     'Tính Tông Theo Chung Loai VT   '
Next Cls
[H5:H6].Value = Space(0)   'Xóa Vùng Criteria  '
End Sub
 
Web KT
Back
Top Bottom