bạn ơi, có cách nào giúp mình không nhỉ?nếu có cả tạm ngưng và ngừng bán thì lấy tạm ngừng bán ak




Sub LayGTTheoDK()
Dim arrVT(), arrTemp, arrGT(), arrKQ
Dim i As Long, j As Long, k As Long
Dim strVar As String
Dim DblPB As Double
Dim chk As Boolean, chk2 As Boolean
arrTemp = Sheet1.Range("A4:D" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
arrGT = Array("Phan bo", "Mo ban", "Tam ngung ban", "Ngung ban luon")
ReDim arrKQ(1 To UBound(arrTemp, 1), 1 To 2)
ReDim arrVT(1 To 2)
strVar = arrTemp(1, 2)
arrVT(1) = "": arrVT(2) = 4
For i = 1 To UBound(arrTemp)
    If UCase(arrTemp(i, 3)) = "PHAN BO" Then
        DblPB = arrTemp(i, 4)
    End If
    If arrTemp(i, 2) = strVar Then
        chk = True
        GoTo GhiVT
V1: Else
        chk2 = True
        GoTo GhiKQ
V3:     arrVT(1) = "": arrVT(2) = 4
        strVar = arrTemp(i, 2)
        chk = False
        GoTo GhiVT
V2: End If
Next
GhiKQ:
    k = k + 1
    arrKQ(k, 1) = strVar
    If arrVT(1) = "PHAN BO" Then
        arrKQ(k, 2) = arrGT(arrVT(2) - 1) & " - " & DblPB
    Else
        arrKQ(k, 2) = arrGT(arrVT(2) - 1)
    End If
    If chk2 = True And i <= UBound(arrTemp, 1) Then GoTo V3: chk2 = False
    
Sheet1.Range("G4:H200").ClearContents
Sheet1.Range("G4").Resize(k, 2) = arrKQ
MsgBox "Xong!"
Exit Sub
GhiVT:
    For j = 0 To UBound(arrGT)
        If UCase(arrGT(j)) = UCase(arrTemp(i, 3)) Then
            If j + 1 < arrVT(2) Then
                arrVT(1) = UCase(arrTemp(i, 3))
                arrVT(2) = j + 1
            End If
            Exit For
        End If
    Next
    If chk = True Then GoTo V1 Else: GoTo V2
End Sub
	cảm ơn bạn nhé, code vẫn còn 1 chút sai sót khi tính toánBấm nút Chạy code nhé!
Rich (BB code):Sub LayGTTheoDK() Dim arrVT(), arrTemp, arrGT(), arrKQ Dim i As Long, j As Long, k As Long Dim strVar As String Dim DblPB As Double Dim chk As Boolean, chk2 As Boolean arrTemp = Sheet1.Range("A4:D" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row) arrGT = Array("Phan bo", "Mo ban", "Tam ngung ban", "Ngung ban luon") ReDim arrKQ(1 To UBound(arrTemp, 1), 1 To 2) ReDim arrVT(1 To 2) strVar = arrTemp(1, 2) arrVT(1) = "": arrVT(2) = 4 For i = 1 To UBound(arrTemp) If UCase(arrTemp(i, 3)) = "PHAN BO" Then DblPB = arrTemp(i, 4) End If If arrTemp(i, 2) = strVar Then chk = True GoTo GhiVT V1: Else chk2 = True GoTo GhiKQ V3: arrVT(1) = "": arrVT(2) = 4 strVar = arrTemp(i, 2) chk = False GoTo GhiVT V2: End If Next GhiKQ: k = k + 1 arrKQ(k, 1) = strVar If arrVT(1) = "PHAN BO" Then arrKQ(k, 2) = arrGT(arrVT(2) - 1) & " - " & DblPB Else arrKQ(k, 2) = arrGT(arrVT(2) - 1) End If If chk2 = True And i <= UBound(arrTemp, 1) Then GoTo V3: chk2 = False Sheet1.Range("G4:H200").ClearContents Sheet1.Range("G4").Resize(k, 2) = arrKQ MsgBox "Xong!" Exit Sub GhiVT: For j = 0 To UBound(arrGT) If UCase(arrGT(j)) = UCase(arrTemp(i, 3)) Then If j + 1 < arrVT(2) Then arrVT(1) = UCase(arrTemp(i, 3)) arrVT(2) = j + 1 End If Exit For End If Next If chk = True Then GoTo V1 Else: GoTo V2 End Sub
