Chuyển đổi công thức sang VBA

Liên hệ QC
vanaccex

vanaccex

Thành viên tiêu biểu
Tham gia
8/7/18
Bài viết
454
Được thích
305
Giới tính
Nữ
Em Vân có 1 vấn đề mong anh (chị) trên diễn đàn giúp đỡ em Vân ạ
Tại Cột J, Sheet Du lieu XK. Em Vân có sử dụng công thức sau
Mã: 
=IF(MAX(SUMIFS('Du lieu NK'!$D$2:$D$53,'Du lieu NK'!$B$2:$B$53,B3,'Du lieu NK'!$C$2:$C$53,"<="&H3)-SUMIFS($I$1:I2,$B$1:B2,B3,$H$1:H2,"<="&H3),0)>=I3,I3,0)
Mục tiêu của công thức này là so sánh phần nhập kho sheet Du lieu NK và phần xuất tại sheet Du lieu XK theo điều kiện số lượng nhập đến trước ngày so sánh bên sheet Du lieu XK sao cho:
+ Hiệu này lớn hơn bằng 0 thì lấy giá trị tại cột I
+ Hiệu Nhỏ <0 thì lấy giá trị bằng 0
Em Vân cảm ơn anh (chị ) nhiều ạ
 

File đính kèm

  • Xuat.xlsm
    38.2 KB · Đọc: 24
Sắp xếp theo thời gian sắp xếp theo bầu chọn
vanaccex đã viết:
Em Vân có 1 vấn đề mong anh (chị) trên diễn đàn giúp đỡ em Vân ạ
Tại Cột J, Sheet Du lieu XK. Em Vân có sử dụng công thức sau
Mã: 
=IF(MAX(SUMIFS('Du lieu NK'!$D$2:$D$53,'Du lieu NK'!$B$2:$B$53,B3,'Du lieu NK'!$C$2:$C$53,"<="&H3)-SUMIFS($I$1:I2,$B$1:B2,B3,$H$1:H2,"<="&H3),0)>=I3,I3,0)
Mục tiêu của công thức này là so sánh phần nhập kho sheet Du lieu NK và phần xuất tại sheet Du lieu XK theo điều kiện số lượng nhập đến trước ngày so sánh bên sheet Du lieu XK sao cho:
+ Hiệu này lớn hơn bằng 0 thì lấy giá trị tại cột I
+ Hiệu Nhỏ <0 thì lấy giá trị bằng 0
Em Vân cảm ơn anh (chị ) nhiều ạ
Nhấp chuột vào đây để mở rộng...
Cho anh hỏi cái dữ liệu bên xuất kho chỉ có 1 ngày thôi hay nhiều ngày vậy.
 
Upvote 0
vanaccex đã viết:
Em Vân có 1 vấn đề mong anh (chị) trên diễn đàn giúp đỡ em Vân ạ
Tại Cột J, Sheet Du lieu XK. Em Vân có sử dụng công thức sau
Mã: 
=IF(MAX(SUMIFS('Du lieu NK'!$D$2:$D$53,'Du lieu NK'!$B$2:$B$53,B3,'Du lieu NK'!$C$2:$C$53,"<="&H3)-SUMIFS($I$1:I2,$B$1:B2,B3,$H$1:H2,"<="&H3),0)>=I3,I3,0)
Mục tiêu của công thức này là so sánh phần nhập kho sheet Du lieu NK và phần xuất tại sheet Du lieu XK theo điều kiện số lượng nhập đến trước ngày so sánh bên sheet Du lieu XK sao cho:
+ Hiệu này lớn hơn bằng 0 thì lấy giá trị tại cột I
+ Hiệu Nhỏ <0 thì lấy giá trị bằng 0
Em Vân cảm ơn anh (chị ) nhiều ạ
Nhấp chuột vào đây để mở rộng...
Em thử cái sub này nhé.
Mã: 
Sub laydulieu()
    Dim arr, kq, data, lr As Long, i As Long, tong As Double, dic As Object, dk As String, ngay As Long, s As String, T, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Du lieu XK")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:L" & lr).Value2
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, i
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
             Else
                s = dic.Item(dk)
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
                For Each T In Split(s, "#")
                    If arr(i, 7) >= arr(T, 7) Then
                       arr(i, 10) = arr(i, 10) + arr(T, 8)
                    End If
                Next
                s = s & "#" & i
                dic.Item(dk) = s
            End If
        Next i
   End With
   With Sheets("Du lieu NK")
        lr1 = .Range("B" & Rows.Count).End(xlUp).Row
        If lr1 > 1 Then
             data = .Range("B2:D" & lr1).Value2
             For i = 1 To UBound(data)
                 dk = data(i, 1)
                 If dic.exists(dk) Then
                    s = dic.Item(dk)
                    For Each T In Split(s, "#")
                        If data(i, 2) <= arr(T, 7) Then
                           arr(T, 11) = arr(T, 11) + data(i, 3)
                        End If
                    Next
                End If
            Next i
      End If
  End With
  With Sheets("Du lieu XK")
       For i = 1 To UBound(arr)
           dk = arr(i, 1)
           s = dic.Item(dk)
           If arr(i, 11) >= arr(i, 10) Then
              kq(i, 1) = arr(i, 8)
           ElseIf s <> "het" Then
               kq(i, 1) = arr(i, 11)
               dic.Item(dk) = "het"
           Else
              kq(i, 1) = 0
           End If
       Next i
       .Range("m2:M" & lr).Value = kq
  End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
snow25 đã viết:
Em thử cái sub này nhé.
Mã: 
Sub laydulieu()
    Dim arr, kq, data, lr As Long, i As Long, tong As Double, dic As Object, dk As String, ngay As Long, s As String, T, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Du lieu XK")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:L" & lr).Value2
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, i
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
             Else
                s = dic.Item(dk)
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
                For Each T In Split(s, "#")
                    If arr(i, 7) >= arr(T, 7) Then
                       arr(i, 10) = arr(i, 10) + arr(T, 8)
                    End If
                Next
                s = s & "#" & i
                dic.Item(dk) = s
            End If
        Next i
   End With
   With Sheets("Du lieu NK")
        lr1 = .Range("B" & Rows.Count).End(xlUp).Row
        If lr1 > 1 Then
             data = .Range("B2:D" & lr1).Value2
             For i = 1 To UBound(data)
                 dk = data(i, 1)
                 If dic.exists(dk) Then
                    s = dic.Item(dk)
                    For Each T In Split(s, "#")
                        If data(i, 2) <= arr(T, 7) Then
                           arr(T, 11) = arr(T, 11) + data(i, 3)
                        End If
                    Next
                End If
            Next i
      End If
  End With
  With Sheets("Du lieu XK")
       For i = 1 To UBound(arr)
           dk = arr(i, 1)
           s = dic.Item(dk)
           If arr(i, 11) >= arr(i, 10) Then
              kq(i, 1) = arr(i, 8)
           ElseIf s <> "het" Then
               kq(i, 1) = arr(i, 11)
               dic.Item(dk) = "het"
           Else
              kq(i, 1) = 0
           End If
       Next i
       .Range("m2:M" & lr).Value = kq
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn xóa thử 1/2 số dòng bên "Du lieu NK" để xem kết quả của công thức và của code.
Tôi nghĩ chuyện này "Dic" không dính dáng, phải cho For chạy đến khi nào bị "đơ" thì thôi.
 
Upvote 0
Công thức bỏ IF thay MIN cho nó gọn, rồi mời bác @Ba Tê xử tiếp
Mã: 
=MIN(MAX(SUMIFS('Du lieu NK'!$D$2:$D$53,'Du lieu NK'!$B$2:$B$53,B2,'Du lieu NK'!$C$2:$C$53,"<="&H2)-SUMIFS($I$1:I1,$B$1:B1,B2,$H$1:H1,"<="&H2),0),I2)
 
Upvote 0

File đính kèm

  • Xuat.xlsb
    40.4 KB · Đọc: 18
Upvote 0
snow25 đã viết:
Em thử cái sub này nhé.
Mã: 
Sub laydulieu()
    Dim arr, kq, data, lr As Long, i As Long, tong As Double, dic As Object, dk As String, ngay As Long, s As String, T, lr1 As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("Du lieu XK")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:L" & lr).Value2
         ReDim kq(1 To UBound(arr), 1 To 1)
         For i = 1 To UBound(arr)
             dk = arr(i, 1)
             If Not dic.exists(dk) Then
                dic.Add dk, i
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
             Else
                s = dic.Item(dk)
                arr(i, 10) = arr(i, 8)
                arr(i, 11) = 0
                For Each T In Split(s, "#")
                    If arr(i, 7) >= arr(T, 7) Then
                       arr(i, 10) = arr(i, 10) + arr(T, 8)
                    End If
                Next
                s = s & "#" & i
                dic.Item(dk) = s
            End If
        Next i
   End With
   With Sheets("Du lieu NK")
        lr1 = .Range("B" & Rows.Count).End(xlUp).Row
        If lr1 > 1 Then
             data = .Range("B2:D" & lr1).Value2
             For i = 1 To UBound(data)
                 dk = data(i, 1)
                 If dic.exists(dk) Then
                    s = dic.Item(dk)
                    For Each T In Split(s, "#")
                        If data(i, 2) <= arr(T, 7) Then
                           arr(T, 11) = arr(T, 11) + data(i, 3)
                        End If
                    Next
                End If
            Next i
      End If
  End With
  With Sheets("Du lieu XK")
       For i = 1 To UBound(arr)
           dk = arr(i, 1)
           s = dic.Item(dk)
           If arr(i, 11) >= arr(i, 10) Then
              kq(i, 1) = arr(i, 8)
           ElseIf s <> "het" Then
               kq(i, 1) = arr(i, 11)
               dic.Item(dk) = "het"
           Else
              kq(i, 1) = 0
           End If
       Next i
       .Range("m2:M" & lr).Value = kq
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ Đúng ý em Vân rồi ạ
Bài đã được tự động gộp:

Ba Tê đã viết:
Cái gì vậy "Chời"!
Nhấp chuột vào đây để mở rộng...
Dạ em Vân cảm ơn anh ạ !. Kết quả này đã đúng ý em Vân rồi ạ !
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Cái gì vậy "Chời"!
Nhấp chuột vào đây để mở rộng...
Anh ơi !. Anh có thể cho em Vân hỏi thêm vấn đề này với.
Nếu như em Vân Thêm sheet TonDauKy vậy thì có thể không dùng từ điển mà vẫn tính toán được như việc sử dụng mảng ở trên không ạ ?
Em Vân cảm ơn anh nhiều ạ !
 

File đính kèm

  • Xuat_2.xlsb
    28.3 KB · Đọc: 6
Upvote 0
vanaccex đã viết:
Anh ơi !. Anh có thể cho em Vân hỏi thêm vấn đề này với.
Nếu như em Vân Thêm sheet TonDauKy vậy thì có thể không dùng từ điển mà vẫn tính toán được như việc sử dụng mảng ở trên không ạ ?
Em Vân cảm ơn anh nhiều ạ !
Nhấp chuột vào đây để mở rộng...
Tôi ít khi trả lời những bài hỏi, đã giải quyết xong, lại "nếu như...".
Nếu như... thì từ đầu phải lường trước "nếu như", tránh việc "phá banh chành" code đã viết.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

V
  • Question
Tìm kiếm và copy giá trị từ bảng đến bảng khác
Trả lời
8
Đọc
165
vnproc
V
N
Em cần giúp tách số thập phân trong chuỗi trên file excel
Trả lời
3
Đọc
39
Duy Tùng 9x
Duy Tùng 9x
K
Đếm số lượng khách hàng quay lại mua hàng trong một khoảng thời gian
2
Trả lời
27
Đọc
5K
lamnguyendh
lamnguyendh
N
Hàm if, lọc dữ liệu trùng
Trả lời
5
Đọc
6K
canhthuyduong
C
O
Hỏi cách xoá vùng dữ liệu trống
Trả lời
6
Đọc
209
onecry
O
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom