trungboss0608
Thành viên mới

- Tham gia
- 28/12/07
- Bài viết
- 6
- Được thích
- 4
Code của bạn đây. Dám chắc đây chỉ là ý tưởng. Code đúng chắc còn xa xôi vì file mẫu quá tạm bợCần sự giúp đỡ
Sub Chen_Dong()
Dim sArr(), i As Long, Res(1 To 1000, 1 To 5), j As Long, k As Long, n As Long
sArr = [A4:D9].Value
For i = 1 To UBound(sArr)
k = k + 1
For j = 1 To 4
Res(k, j) = sArr(i, j)
Next
If sArr(i, 4) > 0 Then
For n = 1 To sArr(i, 4)
k = k + 1
Res(k, 5) = "Chen Them"
Next
End If
Next
[A14].Resize(k, 5) = Res
End Sub
Nhờ a xem lại giúp!Code của bạn đây. Dám chắc đây chỉ là ý tưởng. Code đúng chắc còn xa xôi vì file mẫu quá tạm bợ
Mã:Sub Chen_Dong() Dim sArr(), i As Long, Res(1 To 1000, 1 To 5), j As Long, k As Long, n As Long sArr = [A4:D9].Value For i = 1 To UBound(sArr) k = k + 1 For j = 1 To 4 Res(k, j) = sArr(i, j) Next If sArr(i, 4) > 0 Then For n = 1 To sArr(i, 4) k = k + 1 Res(k, 5) = "Chen Them" Next End If Next [A14].Resize(k, 5) = Res End Sub
Sub InsertRowsForNum()
Dim Rws As Long, J As Long, W As Long, Col As Integer, Dg
Dim Arr()
With Sheets("De bai")
Rws = .[B4].CurrentRegion.Rows.Count
Arr() = .[A4].Resize(Rws, 5).Value
End With
Sheets("KQ").[A4].Resize(Rws, 5).Value = ""
ReDim dArr(1 To 9 * Rws, 1 To 5)
For J = 1 To UBound(Arr())
W = W + 1
For Col = 1 To 5
dArr(W, Col) = Arr(J, Col)
Next Col
If IsNumeric(Arr(J, 5)) Then
For Dg = 1 To Arr(J, 5)
W = W + 1: dArr(W, 2) = UCase$(Arr(J, 2))
Next Dg
End If
Next J
If W Then
Sheets("KQ").[A4].Resize(W, 5).Value = dArr()
End If
End Sub
Cảm ơn anh!. chỗ kết quả cho luôn vào sheets De bai. (khi chạy cod được file như file kết quả) chứ không phải thêm sheets KQPHP:Sub InsertRowsForNum() Dim Rws As Long, J As Long, W As Long, Col As Integer, Dg Dim Arr() With Sheets("De bai") Rws = .[B4].CurrentRegion.Rows.Count Arr() = .[A4].Resize(Rws, 5).Value End With Sheets("KQ").[A4].Resize(Rws, 5).Value = "" ReDim dArr(1 To 9 * Rws, 1 To 5) For J = 1 To UBound(Arr()) W = W + 1 For Col = 1 To 5 dArr(W, Col) = Arr(J, Col) Next Col If IsNumeric(Arr(J, 5)) Then For Dg = 1 To Arr(J, 5) W = W + 1: dArr(W, 2) = UCase$(Arr(J, 2)) Next Dg End If Next J If W Then Sheets("KQ").[A4].Resize(W, 5).Value = dArr() End If End Sub
Sheets("KQ").[A4].Resize(Rws, 5).Value = ""
If W Then
Sheets("KQ").[A4].Resize(W, 5).Value = dArr()
End If