Nguyenhoangphong0902
Đường trần muôn vạn ngã ba.........
- Tham gia
- 27/7/21
- Bài viết
- 56
- Được thích
- 22
Bạn nên sửa lại tiêu đề đi rồi sẽ có codeXin chào các cao thủ, nhờ các cao thủ giải giúp em bài này, giá trị nhân với số lượng sẽ ra số dòng mong muốn. Các anh chị giải dùm em.Đội ơn anh chị cao thủ ạ
Bạn thử dùng code dưới đây:Xin chào các cao thủ, nhờ các cao thủ giải giúp em bài này, giá trị nhân với số lượng sẽ ra số dòng mong muốn. Các anh chị giải dùm em.Đội ơn anh chị cao thủ ạ
View attachment 266775
Sub CamBuoi()
    Dim shData As Worksheet
    Dim arrData, arrSoLuong, arrKetQua
    Dim e As Long, h As Long, n As Long, r As Long, s As Long
    Set shData = Sheets("Sheet1")
    e = shData.Range("A" & shData.Rows.Count).End(xlUp).Row
    arrData = shData.Range("A2:A" & e).Value
    arrSoLuong = shData.Range("B2:B" & e).Value
    s = WorksheetFunction.Sum(arrSoLuong)
    ReDim arrKetQua(1 To s, 1 To 1)
    For r = 1 To UBound(arrData)
        For h = 1 To arrSoLuong(r, 1)
            n = n + 1
            arrKetQua(n, 1) = arrData(r, 1)
        Next
    Next
    shData.Range("D2").Resize(s).Value = arrKetQua
End SubHe he.Hình như bây giờ cái vụ "tiu đề" tiêu rồi, không còn cần phải theo điều lệ nữa.


Code này với code bài #3 giống nhau về cách làm. Do mình có nói bạn sửa tiêu đề thì sẽ đưa code lên nên mình đưa lại cho bạn tham khảoEm cảm ơn các cao thủ ạ. Em là người mới còn trẻ người non dại lắm........mong các cao thủ chỉ giáo thêm.
Sub abc()
Dim arr(), Res(), Sum&, i&, j&, K&
With Sheet1
    arr = .Range("A2:B"& .Range("A" & shData.Rows.Count).End(3).Row).Value
    Sum = Application.WorksheetFunction.Sum(.Range("B:B"))
    If Sum < 0 then Exit Sub
    ReDim Res(1 To Sum)
    For i = 1 To UBound(arr, 1)
        If arr(i, 2) > 0 Then
            For j = 1 To arr(i, 2)
                K = K + 1
                Res(K) = arr(i, 1)
            Next
        End If
    Next
    If k then  .Range("E2").Resize(K).Value = Application.WorksheetFunction.Transpose(Res)
End With
End Sub