Giúp viết code: Cộng dồn, trừ dồn đến hàng tương ứng. (2 người xem)

Hong.Van · 3/1/13

Em chào Thầy cô & anh chị
Xin giúp em viết code cộng dồn, trừ dồn đến dòng tương ứng như sau
Code cho Kết qủa ở cột R & S của Sheet TH
1/ Dùng Mã hàng hóa ở cột K của sheet TH, để dò sang cột B của Sheet T00 để lấy dữ liệu ở cột L hay M sau đó cộng trừ dồn
Cụ thể công thức tại Sheet TH như sau
Cell R9=

PHP:

=SUMIF(T00!$B$9:$B$500;TH!$K9;T00!$L$9:$L$500)+SUMIF(TH!$K$9:K9;TH!$K9;TH!$N$9:N9)-SUMIF(TH!$K$9:K9;TH!$K9;TH!$P$9:P9)

Cell S9=

PHP:

=SUMIF(T00!$B$9:$B$500;TH!$K9;T00!$M$9:$M$500)+SUMIF(TH!$K$9:K9;TH!$K9;TH!$O$9:O9)-SUMIF(TH!$K$9:K9;TH!$K9;TH!$Q$9:Q9)

(trong File em có cthức)
Em cũng biết chút ít về viết code hàm Sumif(), nhưng trong trường hợp hợp này em bị bí!
Vì số liệu nhiều nên giúp em viết dạng mảng. Em cảm ơn

Quang_Hải · 3/1/13

Hong.Van đã viết:
Em chào Thầy cô & anh chị
Xin giúp em viết code cộng dồn, trừ dồn đến dòng tương ứng như sau
Em cũng biết chút ít về viết code hàm Sumif(), nhưng trong trường hợp hợp này em bị bí!
Vì số liệu nhiều nên giúp em viết dạng mảng. Em cảm ơn

Mình nghĩ bài này nằm trong khả năng của HongVan mà. Sao không cố lên.
Mình gợi ý cho HongVan nhé. Mấu chốt nằm tại n= 1 to i sẽ xử lý vấn đề của bạn đấy.

PHP:

For i = 1 To 
   For j = 1 To
      If ..... Then

      End If
   Next j
   For n = 1 To i
      If .... Then

      End If
   Next n
Next i

PS: Mình nghĩ đây là 1 dạng bài tập hay. Sao các bạn mới tham gia viết code không thử sức xem sao.

thanhlanh · 4/1/13

Mình thì thấy công thức của HVan kỳ quá, không biết có nhầm không, trong Sheet TH! chỉ cần thay đổi cột số lượng nhập ở một ô, thì số lượng tồn nhiều ô thay đổi theo, nếu cùng mã hàng --> nhập 1 mà tồn 2,3, ...
Đáng lý cột mã hàng không được trùng chớ nhỉ?

Hong.Van · 4/1/13

thanhlanh đã viết:
Mình thì thấy công thức của HVan kỳ quá, không biết có nhầm không, trong Sheet TH! chỉ cần thay đổi cột số lượng nhập ở một ô, thì số lượng tồn nhiều ô thay đổi theo, nếu cùng mã hàng --> nhập 1 mà tồn 2,3, ...
Đáng lý cột mã hàng không được trùng chớ nhỉ?

Để em lý giải cho anh như thế này
1/ Sheet T00 : là tồn cuối năm trước
2/ Sheet TH là tổng hợp chi tiết nhập xuất toàn bộ trong một năm hiện tại
Cấu trúc như Sheet TH sẽ có thêm những điểm thuận lợi sau:
a/ Tại 1 thời điểm bất kỳ, khi số lượng xuất ra nhiều hơn số tồn hiện tại của 1 mã hàng hóa thì sẽ thấy ngay số tồn kho âm!
b/ Tận dụng File này để làm Sổ chi tiết hàng hóa cho từng mã hàng hóa trong 1 thời điểm nhất định
------------------

quanghai 1969 đã viết:
Mình nghĩ bài này nằm trong khả năng của HongVan mà. Sao không cố lên.
Mình gợi ý cho HongVan nhé. Mấu chốt nằm tại n= 1 to i sẽ xử lý vấn đề của bạn đấy.
PHP Code:
For i = 1 To
For j = 1 To
If ..... Then

End If
Next j
For n = 1 To i
If .... Then

End If
Next n

Next i

Em cũng suy như vậy, nhưng chưa nghĩ ra thuật toán cần làm như thế nào?
Trước đây em cũng viết kiểu này

Mã:

Sub TaoCK()
'Tao cot  R, S cua Sheet TH
    On Error Resume Next
    Application.ScreenUpdating = False
    With Range([B9], [B12000].End(xlUp))
        .Offset(, 16).Value = "=SUMIF(T00!$B$9:$B$500,TH!$K9,T00!$L$9:$L$500)+SUMIF(TH!$K$9:K9,TH!$K9,TH!$N$9:N9)-SUMIF(TH!$K$9:K9,TH!$K9,TH!$P$9:P9)"
        .Offset(, 17).Value = "=SUMIF(T00!$B$9:$B$500,TH!$K9,T00!$M$9:$M$500)+SUMIF(TH!$K$9:K9,TH!$K9,TH!$O$9:O9)-SUMIF(TH!$K$9:K9,TH!$K9,TH!$Q$9:Q9)"
        With .Offset(, 8).Resize(, 9)
            .Value = .Value
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Nhưng số liệu nhiều thì !?
Anh hướng dẫn tiếp nha!
------------------
Em cũng đã viết code như sau

Mã:

Sub KyCuoi()
    Dim sArray, arr()
    Dim i As Long
    Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range
    Dim Wf As WorksheetFunction
    Set Wf = WorksheetFunction
    With Sheets("T00")
        Set n1 = .Range(.[B9], .[B65536].End(3))
        Set n2 = n1.Offset(, 10)
        Set n3 = n1.Offset(, 11)
    End With
    With ActiveSheet
        Set n4 = .Range(.[K9], .[K65536].End(3))
        sArray = n4.Resize(, 9).Value
    End With
    ReDim arr(1 To UBound(sArray, 1), 1 To 2)
    For i = 1 To UBound(sArray, 1)
        Set n5 = Range(sArray(1, 4), sArray(i, 4))
        Set n6 = Range(sArray(1, 5), sArray(i, 5))
        Set n7 = Range(sArray(1, 6), sArray(i, 6))
        Set n8 = Range(sArray(1, 7), sArray(i, 7))
        If sArray(i, 1) <> "" Then
            arr(i, 1) = Wf.SumIf(n1, sArray(i, 1), n2) + Wf.SumIf(n4, sArray(i, 1), n5) - Wf.SumIf(n4, sArray(i, 1), n7)
            arr(i, 2) = Wf.SumIf(n1, sArray(i, 1), n3) + Wf.SumIf(n4, sArray(i, 1), n6) - Wf.SumIf(n4, sArray(i, 1), n8)
        End If
    Next i
    Range("R9").Resize(UBound(arr, 1), 2).Value = arr
End Sub

Code báo sai chỗ Set n5, n6, n7, n8. Khi viết em biết sai, nhưng không biết làm cách nào?
Em nhờ Thầy cô & anh chị sửa code giúp em vậy!
Em cảm ơn.

dhn46 · 4/1/13

Bạn tham khảo Code sau

Mã:

Sub TonCuoi()Dim ArrTon, Arr, sArr
Dim i, j, k As Long, Dic As Object


Sheets("T00").Select
ArrTon = Sheets("T00").Range("B9:M" & Range("B65536").End(3).Row)
Sheets("Th").Select
Arr = Sheets("TH").Range("K9:S" & Range("K65536").End(3).Row)


ReDim sArr(1 To UBound(Arr), 1 To 6)


Set Dic = CreateObject("Scripting.Dictionary")


With Dic
    For i = 1 To UBound(Arr, 1)
        If Not .exists(Arr(i, 1)) Then
            k = k + 1
            .Add Arr(i, 1), k
            For j = 1 To UBound(ArrTon, 1) 'Tim ton trong sheet T00 cho ma Arr(i,1)
                If ArrTon(j, 1) = Arr(i, 1) Then
                    sArr(k, 1) = sArr(k, 1) + ArrTon(j, 11) 'Sl Ton
                    sArr(k, 2) = sArr(k, 2) + ArrTon(j, 12) 'Tien Ton
                End If
            Next j
            '---------------
            sArr(k, 3) = Arr(i, 4) 'SL Nhap
            sArr(k, 4) = Arr(i, 6) 'SL Xuat
            sArr(k, 5) = Arr(i, 5) 'Tien Nhap
            sArr(k, 6) = Arr(i, 6) ' Tien Xuat
        Else
            sArr(k, 3) = sArr(k, 3) + Arr(i, 4) 'SL Nhap
            sArr(k, 4) = sArr(k, 4) + Arr(i, 6) 'SL Xuat
            sArr(k, 5) = sArr(k, 5) + Arr(i, 5) 'Tien Nhap
            sArr(k, 6) = sArr(k, 6) + Arr(i, 6) ' Tien Xuat
        End If
        '----------------Gan du lieu vao Arr
        Arr(i, 8) = sArr(.Item(Arr(i, 1)), 1) + sArr(.Item(Arr(i, 1)), 3) - sArr(.Item(Arr(i, 1)), 4)
        Arr(i, 9) = sArr(.Item(Arr(i, 1)), 2) + sArr(.Item(Arr(i, 1)), 5) - sArr(.Item(Arr(i, 1)), 6)
    Next i
End With
Sheets("th").[K9].Resize(UBound(Arr, 1), 9) = Arr
End Sub

Nhân đây các anh chị cho em hỏi tại sao với bài trên khi em dùng

Mã:

ArrTon = Sheets("T00").Range("B9:M" & Range("B65536").End(3).Row)

Chỉ trả về số phần tử trong mảng là 2
Còn nếu dùng

Mã:

Sheets("T00").Select
ArrTon = Sheets("T00").Range("B9:M" & Range("B65536").End(3).Row)

Thì số phần tử mới trả về 35?

Quang_Hải · 4/1/13

Hong.Van đã viết:
Để em lý giải cho anh như thế này
1/ Sheet T00 : là tồn cuối năm trước
2/ Sheet TH là tổng hợp chi tiết nhập xuất toàn bộ trong một năm hiện tại
Cấu trúc như Sheet TH sẽ có thêm những điểm thuận lợi sau:
a/ Tại 1 thời điểm bất kỳ, khi số lượng xuất ra nhiều hơn số tồn hiện tại của 1 mã hàng hóa thì sẽ thấy ngay số tồn kho âm!
b/ Tận dụng File này để làm Sổ chi tiết hàng hóa cho từng mã hàng hóa trong 1 thời điểm nhất định
------------------

Em cũng suy như vậy, nhưng chưa nghĩ ra thuật toán cần làm như thế nào?
Trước đây em cũng viết kiểu này

Nhưng số liệu nhiều thì !?
Anh hướng dẫn tiếp nha!

Em cảm ơn.

Bạn thử code này coi đúng không. Code mình viết vội, nếu đúng thì khai báo biến lại cho đàng hoàng.

PHP:

Sub congdon()
Dim Sarr(), DesArr(), i, j, n
Sarr = Sheet2.Range(Sheet2.[B9], Sheet2.[B65536].End(3)).Resize(, 12).Value
DesArr = Sheet4.Range(Sheet4.[K9], Sheet4.[K65536].End(3)).Resize(, 9).Value
For i = 1 To UBound(DesArr)
   For j = 1 To UBound(Sarr)
      If DesArr(i, 1) = Sarr(j, 1) Then
         DesArr(i, 8) = Sarr(j, 11)
         DesArr(i, 9) = Sarr(j, 12)
      End If
   Next j
   For n = 1 To i
      If DesArr(i, 1) = DesArr(n, 1) Then
         DesArr(i, 8) = DesArr(i, 8) + DesArr(n, 4) - DesArr(n, 6)
         DesArr(i, 9) = DesArr(i, 9) + DesArr(n, 5) - DesArr(n, 7)
      End If
   Next n
Next i
Sheet4.[K9].Resize(i - 1, 9) = DesArr
End Sub

PS: Không nhảy xuống nước bơi thì còn lâu lắm mới biết bơi nhé.

Hong.Van · 4/1/13

dhn46 đã viết:

Bạn tham khảo Code sau

Mã:

Sub TonCuoi()Dim ArrTon, Arr, sArr
Dim i, j, k As Long, Dic As Object


Sheets("T00").Select
ArrTon = Sheets("T00").Range("B9:M" & Range("B65536").End(3).Row)
Sheets("Th").Select
Arr = Sheets("TH").Range("K9:S" & Range("K65536").End(3).Row)


ReDim sArr(1 To UBound(Arr), 1 To 6)


Set Dic = CreateObject("Scripting.Dictionary")


With Dic
    For i = 1 To UBound(Arr, 1)
        If Not .exists(Arr(i, 1)) Then
            k = k + 1
            .Add Arr(i, 1), k
            For j = 1 To UBound(ArrTon, 1) 'Tim ton trong sheet T00 cho ma Arr(i,1)
                If ArrTon(j, 1) = Arr(i, 1) Then
                    sArr(k, 1) = sArr(k, 1) + ArrTon(j, 11) 'Sl Ton
                    sArr(k, 2) = sArr(k, 2) + ArrTon(j, 12) 'Tien Ton
                End If
            Next j
            '---------------
            sArr(k, 3) = Arr(i, 4) 'SL Nhap
            sArr(k, 4) = Arr(i, 6) 'SL Xuat
            sArr(k, 5) = Arr(i, 5) 'Tien Nhap
            sArr(k, 6) = Arr(i, 6) ' Tien Xuat
        Else
            sArr(k, 3) = sArr(k, 3) + Arr(i, 4) 'SL Nhap
            sArr(k, 4) = sArr(k, 4) + Arr(i, 6) 'SL Xuat
            sArr(k, 5) = sArr(k, 5) + Arr(i, 5) 'Tien Nhap
            sArr(k, 6) = sArr(k, 6) + Arr(i, 6) ' Tien Xuat
        End If
        '----------------Gan du lieu vao Arr
        Arr(i, 8) = sArr(.Item(Arr(i, 1)), 1) + sArr(.Item(Arr(i, 1)), 3) - sArr(.Item(Arr(i, 1)), 4)
        Arr(i, 9) = sArr(.Item(Arr(i, 1)), 2) + sArr(.Item(Arr(i, 1)), 5) - sArr(.Item(Arr(i, 1)), 6)
    Next i
End With
Sheets("th").[K9].Resize(UBound(Arr, 1), 9) = Arr
End Sub

Anh coi code lại giúp em, code chạy cho kết qủa chưa chính xác!
Trong Sheet TH, cột U & V em paste value số liệu cột R & S qua, cột W & X để so sánh sau khi chạy code, nếu code chạy đúng thì kết qủa cột W & X sẽ bằng không
Em cảm ơn!

Hong.Van · 4/1/13

quanghai1969 đã viết:
Bạn thử code này coi đúng không. Code mình viết vội, nếu đúng thì khai báo biến lại cho đàng hoàng.

PHP:

Sub congdon() Dim Sarr(), DesArr(), i, j, n Sarr = Sheet2.Range(Sheet2.[B9], Sheet2.[B65536].End(3)).Resize(, 12).Value DesArr = Sheet4.Range(Sheet4.[K9], Sheet4.[K65536].End(3)).Resize(, 9).Value For i = 1 To UBound(DesArr) For j = 1 To UBound(Sarr) If DesArr(i, 1) = Sarr(j, 1) Then DesArr(i, 8) = Sarr(j, 11) DesArr(i, 9) = Sarr(j, 12) End If Next j For n = 1 To i If DesArr(i, 1) = DesArr(n, 1) Then DesArr(i, 8) = DesArr(i, 8) + DesArr(n, 4) - DesArr(n, 6) DesArr(i, 9) = DesArr(i, 9) + DesArr(n, 5) - DesArr(n, 7) End If Next n Next i Sheet4.[K9].Resize(i - 1, 9) = DesArr End Sub

PS: Không nhảy xuống nước bơi thì còn lâu lắm mới biết bơi nhé.

Xin lỗi là em quên nói với anh là: CÓ NHỮNG MÃ HÀNG HÓA MÀ BÊN SHEET "TH" CÓ MÀ BÊN SHEET "T00" KHÔNG CÓ!
Ví dụ mã H024
Vì thế anh sửa giúp em code trên.
Trong File Anh lưu ý so sánh giữa chạy code và cthức ở cột W & X
Em cảm ơn!

ndu96081631 · 4/1/13

Hong.Van đã viết:

Em cũng đã viết code như sau

Mã:

Sub KyCuoi()
    Dim sArray, arr()
    Dim i As Long
    Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range
    Dim Wf As WorksheetFunction
    Set Wf = WorksheetFunction
    With Sheets("T00")
        Set n1 = .Range(.[B9], .[B65536].End(3))
        Set n2 = n1.Offset(, 10)
        Set n3 = n1.Offset(, 11)
    End With
    With ActiveSheet
        Set n4 = .Range(.[K9], .[K65536].End(3))
        sArray = n4.Resize(, 9).Value
    End With
    ReDim arr(1 To UBound(sArray, 1), 1 To 2)
    For i = 1 To UBound(sArray, 1)
        Set n5 = Range(sArray(1, 4), sArray(i, 4))
        Set n6 = Range(sArray(1, 5), sArray(i, 5))
        Set n7 = Range(sArray(1, 6), sArray(i, 6))
        Set n8 = Range(sArray(1, 7), sArray(i, 7))
        If sArray(i, 1) <> "" Then
            arr(i, 1) = Wf.SumIf(n1, sArray(i, 1), n2) + Wf.SumIf(n4, sArray(i, 1), n5) - Wf.SumIf(n4, sArray(i, 1), n7)
            arr(i, 2) = Wf.SumIf(n1, sArray(i, 1), n3) + Wf.SumIf(n4, sArray(i, 1), n6) - Wf.SumIf(n4, sArray(i, 1), n8)
        End If
    Next i
    Range("R9").Resize(UBound(arr, 1), 2).Value = arr
End Sub

Code báo sai chỗ Set n5, n6, n7, n8. Khi viết em biết sai, nhưng không biết làm cách nào?
Em nhờ Thầy cô & anh chị sửa code giúp em vậy!
Em cảm ơn.

Bài này lý ra dùng Dictionary là ngon lành nhất (nhưng sẽ khó hiểu)
Vậy tôi sửa lại code của bạn (vẫn theo giải thuật dùng SUMIF
Bạn có 2 chổ sai:
- Set n4 phải nằm trong vòng lập (vì theo công thức của bạn thì vùng này nó chạy theo i)
- Set n5 = Range(sArray(1, 4), sArray(i, 4)) là sai vì sArray(1, 4) và sArray(i, 4) không phải là Range
Xem code nhé:

Mã:

Sub KyCuoi()
  Dim sArray, arr()
  Dim i As Long
  Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range
  Dim Wf As WorksheetFunction
  Set Wf = WorksheetFunction
  With Sheets("T00")
    Set n1 = .Range(.[B9], .[B65536].End(3))
    Set n2 = n1.Offset(, 10)
    Set n3 = n1.Offset(, 11)
  End With
  [COLOR=#ff0000]With Sheets("TH")[/COLOR]
    sArray = .Range(.[K9], .[K65536].End(3)).Value
    ReDim arr(1 To UBound(sArray, 1), 1 To 2)
    For i = 1 To UBound(sArray, 1)
      [COLOR=#ff0000]Set n4 = .Range(.Cells(9, "K"), .Cells(8 + i, "K"))
      Set n5 = .Range(.Cells(9, "N"), .Cells(8 + i, "N"))
      Set n6 = .Range(.Cells(9, "O"), .Cells(8 + i, "O"))
      Set n7 = .Range(.Cells(9, "P"), .Cells(8 + i, "P"))
      Set n8 = .Range(.Cells(9, "Q"), .Cells(8 + i, "Q"))[/COLOR]
      If sArray(i, 1) <> "" Then
        arr(i, 1) = Wf.SumIf(n1, sArray(i, 1), n2) + Wf.SumIf(n4, sArray(i, 1), n5) - Wf.SumIf(n4, sArray(i, 1), n7)
        arr(i, 2) = Wf.SumIf(n1, sArray(i, 1), n3) + Wf.SumIf(n4, sArray(i, 1), n6) - Wf.SumIf(n4, sArray(i, 1), n8)
      End If
    Next i
    .Range("R9").Resize(UBound(arr, 1), 2).Value = arr
  [COLOR=#ff0000]End With[/COLOR]
End Sub

Chổ màu đỏ viết cho bạn dễ hiểu, nếu rút gọn lại thì có thể viết thế này:

Mã:

[COLOR=#ff0000]Set n4 = .Range(.Cells(9, "K"), .Cells(8 + i, "K"))
Set n5 = n4.Offset(, 3)
Set n6 = n4.Offset(, 4)
Set n7 = n4.Offset(, 5)
Set n8 = n4.Offset(, 6)[/COLOR]

dhn46 · 4/1/13

Hong.Van đã viết:
Anh coi code lại giúp em, code chạy cho kết qủa chưa chính xác!
Trong Sheet TH, cột U & V em paste value số liệu cột R & S qua, cột W & X để so sánh sau khi chạy code, nếu code chạy đúng thì kết qủa cột W & X sẽ bằng không
Em cảm ơn!

Vâng, bạn sửa lại 1 chút nhé

Mã:

Sub TonCuoi()
Dim ArrTon, Arr, sArr
Dim i, j, k As Long, Dic As Object


ArrTon = Sheets("T00").Range("B9:M" & Sheets("T00").Range("B65536").End(3).Row)
Arr = Sheets("TH").Range("K9:S" & Sheets("TH").Range("K65536").End(3).Row)
ReDim sArr(1 To UBound(Arr), 1 To 6)


Set Dic = CreateObject("Scripting.Dictionary")
With Dic
    For i = 1 To UBound(Arr, 1)
        If Not .exists(Arr(i, 1)) Then
            k = k + 1
            .Add Arr(i, 1), k
            For j = 1 To UBound(ArrTon, 1) 'Tim ton trong sheet T00 cho ma Arr(i,1)
                If ArrTon(j, 1) = Arr(i, 1) Then
                    sArr(k, 1) = sArr(k, 1) + ArrTon(j, 11) 'Sl Ton
                    sArr(k, 2) = sArr(k, 2) + ArrTon(j, 12) 'Tien Ton
                End If
            Next j
            '---------------
            sArr(k, 3) = Arr(i, 4) 'SL Nhap
            sArr(k, 4) = Arr(i, 6) 'SL Xuat
            sArr(k, 5) = Arr(i, 5) 'Tien Nhap
            sArr(k, 6) = Arr(i, 7) ' Tien Xuat
        Else
            sArr(.Item(Arr(i, 1)), 3) = sArr(.Item(Arr(i, 1)), 3) + Arr(i, 4) 'SL Nhap
            sArr(.Item(Arr(i, 1)), 4) = sArr(.Item(Arr(i, 1)), 4) + Arr(i, 6) 'SL Xuat
            sArr(.Item(Arr(i, 1)), 5) = sArr(.Item(Arr(i, 1)), 5) + Arr(i, 5) 'Tien Nhap
            sArr(.Item(Arr(i, 1)), 6) = sArr(.Item(Arr(i, 1)), 6) + Arr(i, 7) ' Tien Xuat
        End If
        '----------------Gan du lieu vao Arr
        Arr(i, 8) = sArr(.Item(Arr(i, 1)), 1) + sArr(.Item(Arr(i, 1)), 3) - sArr(.Item(Arr(i, 1)), 4)
        Arr(i, 9) = sArr(.Item(Arr(i, 1)), 2) + sArr(.Item(Arr(i, 1)), 5) - sArr(.Item(Arr(i, 1)), 6)
    Next i
End With
Sheets("th").[K9].Resize(UBound(Arr, 1), 9) = Arr
End Sub

Cau hỏi ở bài trên e đã giải quết được, em xin hỏi thêm các anh chị câu hỏi: Code sửa này có vấn đề với số rất nhỏ (-2.98023223876953E-08). Tại sao khi dùng Sumif ( như với R646 và R648) thì =0 còn Code thì bằng số bé như vậy
Em cảm ơn!

ndu96081631 · 4/1/13

dhn46 đã viết:
Cau hỏi ở bài trên e đã giải quết được, em xin hỏi thêm các anh chị câu hỏi: Code sửa này có vấn đề với số rất nhỏ (-2.98023223876953E-08). Tại sao khi dùng Sumif ( như với R646 và R648) thì =0 còn Code thì bằng số bé như vậy
Em cảm ơn!

Mấy cái này người ta hỏi hoài nhưng cũng chẳng giải quyết được gì ---> Chắc là trong quá trình tính toán, Excel có sai số nào đó
Thôi thì chắc ăn ta ROUND cho nó 1 phát đi (khỏi suy nghĩ)

Quang_Hải · 4/1/13

Hong.Van đã viết:
Xin lỗi là em quên nói với anh là: CÓ NHỮNG MÃ HÀNG HÓA MÀ BÊN SHEET "TH" CÓ MÀ BÊN SHEET "T00" KHÔNG CÓ!
Ví dụ mã H024
Vì thế anh sửa giúp em code trên.
Trong File Anh lưu ý so sánh giữa chạy code và cthức ở cột W & X
Em cảm ơn!

Sao HongVân không thử thêm dòng Sheet4.[R9:S1000].ClearContents trước khi gán dữ liệu vào mảng DesArr nhỉ? Mình có cái tật là không bao giờ viết code tổng quát cả... híc.

Ba Tê · 4/1/13

ndu96081631 đã viết:
Bài này lý ra dùng Dictionary là ngon lành nhất (nhưng sẽ khó hiểu)
Vậy tôi sửa lại code của bạn (vẫn theo giải thuật dùng SUMIF
Bạn có 2 chổ sai:
- Set n4 phải nằm trong vòng lập (vì theo công thức của bạn thì vùng này nó chạy theo i)
- Set n5 = Range(sArray(1, 4), sArray(i, 4)) là sai vì sArray(1, 4) và sArray(i, 4) không phải là Range
Xem code nhé:

Mã:

Sub KyCuoi() Dim sArray, arr() Dim i As Long Dim n1 As Range, n2 As Range, n3 As Range, n4 As Range, n5 As Range, n6 As Range, n7 As Range, n8 As Range Dim Wf As WorksheetFunction Set Wf = WorksheetFunction With Sheets("T00") Set n1 = .Range(.[B9], .[B65536].End(3)) Set n2 = n1.Offset(, 10) Set n3 = n1.Offset(, 11) End With [COLOR=#ff0000]With Sheets("TH")[/COLOR] sArray = .Range(.[K9], .[K65536].End(3)).Value ReDim arr(1 To UBound(sArray, 1), 1 To 2) For i = 1 To UBound(sArray, 1) [COLOR=#ff0000]Set n4 = .Range(.Cells(9, "K"), .Cells(8 + i, "K")) Set n5 = .Range(.Cells(9, "N"), .Cells(8 + i, "N")) Set n6 = .Range(.Cells(9, "O"), .Cells(8 + i, "O")) Set n7 = .Range(.Cells(9, "P"), .Cells(8 + i, "P")) Set n8 = .Range(.Cells(9, "Q"), .Cells(8 + i, "Q"))[/COLOR] If sArray(i, 1) <> "" Then arr(i, 1) = Wf.SumIf(n1, sArray(i, 1), n2) + Wf.SumIf(n4, sArray(i, 1), n5) - Wf.SumIf(n4, sArray(i, 1), n7) arr(i, 2) = Wf.SumIf(n1, sArray(i, 1), n3) + Wf.SumIf(n4, sArray(i, 1), n6) - Wf.SumIf(n4, sArray(i, 1), n8) End If Next i .Range("R9").Resize(UBound(arr, 1), 2).Value = arr [COLOR=#ff0000]End With[/COLOR] End Sub

Chổ màu đỏ viết cho bạn dễ hiểu, nếu rút gọn lại thì có thể viết thế này:

Mã:

[COLOR=#ff0000]Set n4 = .Range(.Cells(9, "K"), .Cells(8 + i, "K")) Set n5 = n4.Offset(, 3) Set n6 = n4.Offset(, 4) Set n7 = n4.Offset(, 5) Set n8 = n4.Offset(, 6)[/COLOR]

Nghỉ lâu quá chắc bị "tẩu hoả nhập ma" rồi.
Viết theo kiểu Dic sao mà dài thoòng... Híc!

PHP:

Public Sub GPE()
Dim Dic As Object, TemArr(), sArr(), dArr(), I As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("T00")
    sArr = .Range(.[B9], .[B65000].End(xlUp)).Resize(, 12).Value
End With
ReDim TemArr(1 To 65000, 1 To 2)
    For I = 1 To UBound(sArr, 1)
        K = K + 1
        Dic.Add sArr(I, 1), K
        TemArr(K, 1) = sArr(I, 11)
        TemArr(K, 2) = sArr(I, 12)
    Next I
With Sheets("TH")
    sArr = .Range(.[K9], .[K65000].End(xlUp)).Resize(, 7).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1)
        If Tem <> "" Then
            If Dic.Exists(Tem) Then
                dArr(I, 1) = TemArr(Dic.Item(Tem), 1) + sArr(I, 4) - sArr(I, 6)
                dArr(I, 2) = TemArr(Dic.Item(Tem), 2) + sArr(I, 5) - sArr(I, 7)
                TemArr(Dic.Item(Tem), 1) = dArr(I, 1)
                TemArr(Dic.Item(Tem), 2) = dArr(I, 2)
            Else
                dArr(I, 1) = sArr(I, 4) - sArr(I, 6)
                dArr(I, 2) = sArr(I, 5) - sArr(I, 7)
                K = K + 1
                Dic.Add Tem, K
                TemArr(K, 1) = dArr(I, 1)
                TemArr(K, 2) = dArr(I, 2)
            End If
        End If
    Next I
    .[R9:S10000].ClearContents
    .[R9].Resize(I - 1, 2).Value = dArr
End With
Set Dic = Nothing
End Sub

Giúp viết code: Cộng dồn, trừ dồn đến hàng tương ứng. (2 người xem)

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

Hong.Van

Busy

File đính kèm

Quang_Hải

Thành viên gạo cội

thanhlanh

Thành viên tích cực

Hong.Van

Busy

dhn46

Hướng tới tương lai

Quang_Hải

Thành viên gạo cội

Hong.Van

Busy

File đính kèm

Hong.Van

Busy

File đính kèm

ndu96081631

Huyền thoại GPE

dhn46

Hướng tới tương lai

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

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