Gấp số dòng theo số loại hàng hóa

[Yeuvoyeucon]

Kính gửi anh chị
Em có số liệu tại cột A và B và giữ liệu về loại ở cột E và F. Em muốn kết quả ra như tại cột I đến K thì code thế nào ạ. Ở đây nghĩa là nó nhân số dòng ban đầu theo số Loại của hàng hóa ạ. Mong a CHị giúp đỡ.

 

[SA_DQ]

Bạn thử với macro này xem nha:

Sub NhanBan()
 Dim Cls As Range, Rng As Range, sRng As Range, cRg As Range, Rg0 As Range
 Dim MyAdd As String
 Dim SoDg As Integer
 
 Set Rng = [A1].CurrentRegion
 [K1].CurrentRegion.Offset(1).ClearContents
 For Each Cls In Range([E1], [E1].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If cRg Is Nothing Then
                Set cRg = sRng.Resize(, 2)
            Else
                Set cRg = Union(cRg, sRng.Resize(, 2))
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If Not cRg Is Nothing Then SoDg = cRg.Rows.Count
        Set Rg0 = [I65500].End(xlUp).Offset(1)
        cRg.Copy Destination:=Rg0:              Set cRg = Nothing
        Rg0.Offset(, 2).Resize(SoDg).Value = Cls.Offset(, 1).Value
        SoDg = 0
    End If
 Next Cls
End Sub

 

[Ba Tê]

Kính gửi anh chị
Em có số liệu tại cột A và B và giữ liệu về loại ở cột E và F. Em muốn kết quả ra như tại cột I đến K thì code thế nào ạ. Ở đây nghĩa là nó nhân số dòng ban đầu theo số Loại của hàng hóa ạ. Mong a CHị giúp đỡ.

Đọc tiêu đề chẳng hiểu "Gấp số dòng" là gì, Xem kết quả mẫu mới hiểu.

Public Sub Gpe()
Dim Arr1(), Arr2(), dArr(), I As Long, J As Long, K As Long, Txt As String
    Arr1 = Range("A2", Range("B2").End(xlDown)).Value
    Arr2 = Range("E1", Range("F1").End(xlDown)).Value
ReDim dArr(1 To UBound(Arr1) * UBound(Arr2), 1 To 3)
    For I = 1 To UBound(Arr2)
        Txt = Arr2(I, 1)
        For J = 1 To UBound(Arr1)
            If Arr1(J, 1) = Txt Then
                K = K + 1
                dArr(K, 1) = Txt
                dArr(K, 2) = Arr1(J, 2)
                dArr(K, 3) = Arr2(I, 2)
            End If
        Next J
    Next I
Range("I2").Resize(K, 3) = dArr
End Sub

 

[Yeuvoyeucon]

Đọc tiêu đề chẳng hiểu "Gấp số dòng" là gì, Xem kết quả mẫu mới hiểu.

Public Sub Gpe()
Dim Arr1(), Arr2(), dArr(), I As Long, J As Long, K As Long, Txt As String
    Arr1 = Range("A2", Range("B2").End(xlDown)).Value
    Arr2 = Range("E1", Range("F1").End(xlDown)).Value
ReDim dArr(1 To UBound(Arr1) * UBound(Arr2), 1 To 3)
    For I = 1 To UBound(Arr2)
        Txt = Arr2(I, 1)
        For J = 1 To UBound(Arr1)
            If Arr1(J, 1) = Txt Then
                K = K + 1
                dArr(K, 1) = Txt
                dArr(K, 2) = Arr1(J, 2)
                dArr(K, 3) = Arr2(I, 2)
            End If
        Next J
    Next I
Range("I2").Resize(K, 3) = dArr
End Sub

Em cảm ơn anh đã nhiệt tình trợ giúp ạ !!!

Bài đã được tự động gộp: 9/4/21

Bạn thử với macro này xem nha:

Sub NhanBan()
Dim Cls As Range, Rng As Range, sRng As Range, cRg As Range, Rg0 As Range
Dim MyAdd As String
Dim SoDg As Integer

Set Rng = [A1].CurrentRegion
[K1].CurrentRegion.Offset(1).ClearContents
For Each Cls In Range([E1], [E1].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If cRg Is Nothing Then
                Set cRg = sRng.Resize(, 2)
            Else
                Set cRg = Union(cRg, sRng.Resize(, 2))
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
        If Not cRg Is Nothing Then SoDg = cRg.Rows.Count
        Set Rg0 = [I65500].End(xlUp).Offset(1)
        cRg.Copy Destination:=Rg0:              Set cRg = Nothing
        Rg0.Offset(, 2).Resize(SoDg).Value = Cls.Offset(, 1).Value
        SoDg = 0
    End If
Next Cls
End Sub

Cảm ơn sự nhiệt tình của anh ạ !!!