HỖ TRỢ CÔNG THỨC ĐỂ TRẢ VỀ KẾT QUẢ MONG MUỐN

[nguyensiquynh]

Em chào Anh/chị
Em đang có 1 case nhờ anh chị hỗ trợ giúp em ạ.
Em có bảng 1 và muốn chuyển thành dữ liệu của Bảng 2.
Anh/chị hỗ trợ tư vấn giúp em nhé.
Em cảm ơn ạ

 

[tranchautrungduong]

Sub Chuyen()

    Dim lr As Long
    Dim iRow As Long
    Dim Arr As Variant
    Dim Arr_KQ As Variant
    Dim i As Long
    Dim j As Long
    Dim iType As Long


    lr = ThisWorkbook.Sheets("Sheet1").Range("A" & ThisWorkbook.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    Arr = ThisWorkbook.Sheets("Sheet1").Range("A2:B" & lr).Value
    iRow = 0
   
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        iRow = iRow + Arr(i, 2)
    Next i

    ReDim Arr_KQ(1 To iRow, 1 To 3) As Variant
   
    iRow = 0
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        iType = 0
        For j = 1 To Arr(i, 2)
            iRow = iRow + 1
            iType = iType + 1
            Arr_KQ(iRow, 1) = Arr(i, 1)
            Arr_KQ(iRow, 2) = Arr(i, 2)
            Arr_KQ(iRow, 3) = iType & "/" & Arr(i, 2)
        Next j
    Next i





    ThisWorkbook.Sheets("Sheet1").Range("G2:I" & iRow + 1).Value = Arr_KQ



End Sub

Của bạn đây @nguyensiquynh bấm vào hình mũi tên

 

[nguyensiquynh]

Sub Chuyen()

    Dim lr As Long
    Dim iRow As Long
    Dim Arr As Variant
    Dim Arr_KQ As Variant
    Dim i As Long
    Dim j As Long
    Dim iType As Long


    lr = ThisWorkbook.Sheets("Sheet1").Range("A" & ThisWorkbook.Sheets("Sheet1").Rows.Count).End(xlUp).Row
    Arr = ThisWorkbook.Sheets("Sheet1").Range("A2:B" & lr).Value
    iRow = 0
  
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        iRow = iRow + Arr(i, 2)
    Next i

    ReDim Arr_KQ(1 To iRow, 1 To 3) As Variant
  
    iRow = 0
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        iType = 0
        For j = 1 To Arr(i, 2)
            iRow = iRow + 1
            iType = iType + 1
            Arr_KQ(iRow, 1) = Arr(i, 1)
            Arr_KQ(iRow, 2) = Arr(i, 2)
            Arr_KQ(iRow, 3) = iType & "/" & Arr(i, 2)
        Next j
    Next i





    ThisWorkbook.Sheets("Sheet1").Range("G2:I" & iRow + 1).Value = Arr_KQ



End Sub

Của bạn đây @nguyensiquynh bấm vào hình mũi tên

Cảm ơn anh rất nhiều ạ

 

[HieuCD]

Em chào Anh/chị
Em đang có 1 case nhờ anh chị hỗ trợ giúp em ạ.
Em có bảng 1 và muốn chuyển thành dữ liệu của Bảng 2.
Anh/chị hỗ trợ tư vấn giúp em nhé.
Em cảm ơn ạ
View attachment 284395

G2 =IF(ROWS($1:1)>SUM($B$2:$B$4),"",LOOKUP(2,1/(SUMIF(OFFSET($B$1,,,ROW($1:$3)),">0")+1<=ROWS($1:1)),$A$2:$A$4))
H2 =IFERROR(LOOKUP(G2,$A$2:$A$4,$B$2:$B$4),"")
I2 =IF(G2="","",COUNTIF($G$1:G2,G2)&"/"&H2)

Copy xuống . . . .