Tự thêm dòng theo điều kiện và số lượng cho trước (1 người xem)

[myly2411]

Chào các Anh/Chị!
Mình có 1 file dữ liệu (đính kèm) có 2 sheet:
Sheet1 có dữ liệu như trên. Trong đó:
A3 là 01.CT và O3 là 3
A4 là trống và O4 là 0
A5 là 10.LA và O5 là 2
=> Mình mong muốn kết quả ở Sheet2 sẽ là:
A3 là 01.CT_01
A4 là 01.CT_02
A5 là 01.CT_03
A6 là 10.LA_01
A7 là 10.LA_02
Mong các Anh/Chị hỗ trợ giúp! Cảm ơn Anh/Chị rất nhiều.

 

[snow25]

Chào các Anh/Chị!
Mình có 1 file dữ liệu (đính kèm) có 2 sheet:
Sheet1 có dữ liệu như trên. Trong đó:
A3 là 01.CT và O3 là 3
A4 là trống và O4 là 0
A5 là 10.LA và O5 là 2
=> Mình mong muốn kết quả ở Sheet2 sẽ là:
A3 là 01.CT_01
A4 là 01.CT_02
A5 là 01.CT_03
A6 là 10.LA_01
A7 là 10.LA_02
Mong các Anh/Chị hỗ trợ giúp! Cảm ơn Anh/Chị rất nhiều.

Bạn thử.

Function layso(ByVal mang1 As Range, ByVal mang2 As Range)
        Dim arr1, arr2, i As Long, a As Long, kq(1 To 1000, 1 To 1) As String, j As Long
        arr1 = laymang(mang1)
        arr2 = laymang(mang2)
        For i = 1 To UBound(arr1)
            If Len(arr1(i, 1)) > 0 Then
               For j = 1 To arr2(i, 1)
                   a = a + 1
                   kq(a, 1) = arr1(i, 1) & "_" & Format(j, "0,0")
               Next j
           End If
       Next i
       layso = kq
End Function
Function laymang(ByVal mang As Range)
        Dim arr
        If mang.Count = 1 Then
           ReDim arr(1 To 1, 1 To 1)
           arr = mang.Value
        Else
           arr = mang.Value
        End If
        laymang = arr
End Function

=layso(Sheet1!A3:A5,Sheet1!O3:O5)

 

[myly2411]

Bạn thử.

Function layso(ByVal mang1 As Range, ByVal mang2 As Range)
        Dim arr1, arr2, i As Long, a As Long, kq(1 To 1000, 1 To 1) As String, j As Long
        arr1 = laymang(mang1)
        arr2 = laymang(mang2)
        For i = 1 To UBound(arr1)
            If Len(arr1(i, 1)) > 0 Then
               For j = 1 To arr2(i, 1)
                   a = a + 1
                   kq(a, 1) = arr1(i, 1) & "_" & Format(j, "0,0")
               Next j
           End If
       Next i
       layso = kq
End Function
Function laymang(ByVal mang As Range)
        Dim arr
        If mang.Count = 1 Then
           ReDim arr(1 To 1, 1 To 1)
           arr = mang.Value
        Else
           arr = mang.Value
        End If
        laymang = arr
End Function

=layso(Sheet1!A3:A5,Sheet1!O3:O5)

Ôi tuyệt vời quá! cảm ơn bạn rất nhiều.