Public Sub LOC_BIEU1()
On Error GoTo thoat
Application.EnableEvents = False
Dim sArr(), dArr(1 To 1, 1 To 1), dArr2(), I As Long, j As Long, DK As String, SoTrang As Double, le As Boolean
Dim K As Long, Ong As String, Ba As String, Kem_theo As String, T_Tong As String, Ngay_Thang As String, NguoiVietDon As String
Dim Ky_Ten As String, Nhan_SD As String
With Sheets("DATA")
sArr = .Range(.[A2], .[A65536].End(xlUp)).Resize(, 44).Value
End With
With Sheets("Bieu_05")
DK = .[J3].Value: Ong = .[AA3].Value: Ba = [AA4].Value: Kem_theo = .[AA2].Value: Nhan_SD = [AA5].Value: T_Tong = [AA6].Value
Ngay_Thang = [AA7].Value: NguoiVietDon = [AA8].Value: Ky_Ten = [AA9].Value
For I = 1 To UBound(sArr, 1)
If sArr(I, 5) = DK Then
'Dien thong tin CQL1
If sArr(I, 26) = 1 Then
dArr(1, 1) = "(" & Kem_theo & Ong & sArr(I, 2) & ")"
ElseIf sArr(I, 26) = 2 Then
dArr(1, 1) = "(" & Kem_theo & Ba & sArr(I, 2) & ")"
Else
dArr(1, 1) = vbNullString
End If
Exit For
End If
Next I
ReDim dArr2(1 To UBound(sArr, 1), 1 To 8)
For N = I To UBound(sArr, 1)
If sArr(N, 5) = DK Then
K = K + 1
dArr2(K, 1) = K: dArr2(K, 2) = sArr(N, 13): dArr2(K, 3) = sArr(N, 14)
If sArr(N, 3) <> "" And sArr(N, 17) <> "" Then
dArr2(K, 4) = sArr(N, 17) & ", " & sArr(N, 3)
ElseIf sArr(N, 3) <> "" And sArr(N, 17) = "" Then
dArr2(K, 4) = sArr(N, 3)
ElseIf sArr(N, 3) = "" And sArr(N, 17) <> "" Then
dArr2(K, 4) = sArr(N, 17)
Else
dArr2(K, 4) = vbNullString
End If
dArr2(K, 5) = sArr(N, 15)
tong = tong + dArr2(K, 5)
End If
Next N
dArr2(K + 1, 5) = tong "Định dạng chữ kiểu B"
dArr2(K + 1, 1) = T_Tong "Định dạng chữ kiểu B"
dArr2(K + 2, 7) = Ngay_Thang
dArr2(K + 3, 7) = NguoiVietDon "Định dạng chữ kiểu I nghiêng"dArr2(K + 4, 7) = Ky_Ten
[A7:H65536].ClearContents
[A7:H65536].Borders.LineStyle = xlNone
If K Then
.[A2:G2].Value = dArr
.[A7].Resize(K + 5, 8).Value = dArr2
.[A7].Resize(K + 1, 8).Borders.LineStyle = xlContinuous
End If
thoat:
Application.EnableEvents = True
End With
End Sub
