Giúp Code cộng dồn số lượng theo tên hàng cùa 2 vùng (1 người xem)

Liên hệ QC

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

minhtuan55

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
23/3/16
Bài viết
705
Được thích
52
Chào cả nhà GPE
Mong cả nhà giúp em 1 đoạn Code cộng dồn số lượng của 2 khu ( em có ghi rõ trong file )
Thank cả nhà
 

File đính kèm

Mã:
Sub GopBan()
Dim B1(), B2(), GB(), r As Integer, j As Integer, k As Integer, i As Integer, chk As Boolean
B1 = Sheet1.Range("B4:C23").Value
B2 = Sheet1.Range("F4:G23").Value
ReDim GB(1 To UBound(B1, 1) + UBound(B2, 1), 1 To 2)
For r = 1 To UBound(B1, 1)
    If B1(r, 1) <> "" Then k = k + 1: GB(k, 1) = B1(r, 1): GB(k, 2) = B1(r, 2)
Next r
For j = 1 To UBound(B2, 1)
    If B2(j, 1) <> "" Then
        For i = 1 To r
            If B2(j, 1) = GB(i, 1) Then
                GB(i, 2) = GB(i, 2) + B2(j, 2): GoTo 1
            Else
                chk = True
            End If
        Next i
        If chk = True Then
                k = k + 1
                GB(k, 1) = B2(j, 1): GB(k, 2) = B2(j, 2)
        End If
    End If
1:
Next j
Sheet1.Range("K4").Resize(UBound(GB, 1), 2) = GB
End Sub
 
Upvote 0
Code a quá tuyệt. anh có thể hướng dẫn mô tả từng đoạn code cho e hiểu được không
e chẳng biết Redim, UBound là cái gi nua. Mong a huong dan



Mã:
Sub GopBan()
Dim B1(), B2(), GB(), r As Integer, j As Integer, k As Integer, i As Integer, chk As Boolean
B1 = Sheet1.Range("B4:C23").Value
B2 = Sheet1.Range("F4:G23").Value
ReDim GB(1 To UBound(B1, 1) + UBound(B2, 1), 1 To 2)
For r = 1 To UBound(B1, 1)
    If B1(r, 1) <> "" Then k = k + 1: GB(k, 1) = B1(r, 1): GB(k, 2) = B1(r, 2)
Next r
For j = 1 To UBound(B2, 1)
    If B2(j, 1) <> "" Then
        For i = 1 To r
            If B2(j, 1) = GB(i, 1) Then
                GB(i, 2) = GB(i, 2) + B2(j, 2): GoTo 1
            Else
                chk = True
            End If
        Next i
        If chk = True Then
                k = k + 1
                GB(k, 1) = B2(j, 1): GB(k, 2) = B2(j, 2)
        End If
    End If
1:
Next j
Sheet1.Range("K4").Resize(UBound(GB, 1), 2) = GB
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom