Sub 分级产品() '分级产品的数据
Dim myPath, file1, AK As Workbook, i As Integer, K As Integer, br(32)
Application.ScreenUpdating = False
myPath = "E:\最新估值表（新接口）\"
Set w1 = Worksheets("更新产品")
K = w1.Range("b65536").End(xlUp).Row '第2列已用行数
For i = 2 To K
For j = 0 To 30 '用于暂存数据，每次要清零
br(j) = 0
Next j
file1 = w1.Cells(i, 2).Value '对应估值表的名称
myfile = myPath & file1 & ".xls"
Set AK = Workbooks.Open(myfile)
br(2) = Mid(AK.Worksheets(file1).[a3], 6) '取出估值时间
kk = AK.Worksheets(file1).Range("a65536").End(xlUp).Row '第1列已用行数
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "资产净值") > 0 Then
br(3) = Application.WorksheetFunction.VLookup("资产净值", AK.Worksheets(file1).Cells, 8, False)
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "资产合计") > 0 Then
br(4) = Application.WorksheetFunction.VLookup("资产合计", AK.Worksheets(file1).Cells, 8, False)
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "实收资本") > 0 Then
br(5) = Application.WorksheetFunction.VLookup("实收资本", AK.Worksheets(file1).Cells, 8, False)
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "其中债券投资") > 0 Then
br(10) = Application.WorksheetFunction.VLookup("其中债券投资", AK.Worksheets(file1).Cells, 8, False)
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "银行间_已上市_企业债") > 0 Then
br(12) = Application.WorksheetFunction.VLookup("银行间_已上市_企业债", AK.Worksheets(file1).Cells, 8, False)
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "100201") > 0 Then
br(14) = Application.WorksheetFunction.VLookup("100201", AK.Worksheets(file1).Cells, 8, False) '活期存款
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "1021") > 0 Then
br(15) = Application.WorksheetFunction.VLookup("1021", AK.Worksheets(file1).Cells, 8, False) '备付金
End If
If WorksheetFunction.CountIf(AK.Worksheets(file1).[a1:a800], "1031") > 0 Then
br(16) = Application.WorksheetFunction.VLookup("1031", AK.Worksheets(file1).Cells, 8, False) '存出保证金
End If
'优先级相关数据提取
k21 = 0 '有时存在多个优先级，需要累加
For s = 5 To kk '取优先级份额
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k22 = AK.Worksheets(file1).Cells(s, 3) '取出第3列的数值
If InStr(kemu, "实收资本") > 0 Then
If InStr(kemu, "优先级") > 0 Or InStr(kemu, "优先") > 0 Or InStr(kemu, "A类") > 0 Then
k21 = k21 + k22
End If
End If
Next s
br(17) = k21 '记录优先份额
k23 = 0
For s = 5 To kk '取优先级净值
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k24 = AK.Worksheets(file1).Cells(s, 8) '取出第8列的数值
If InStr(kemu, "资产净值") > 0 Then
If InStr(kemu, "优先级") > 0 Or InStr(kemu, "优先") > 0 Or InStr(kemu, "A类") > 0 Then
k23 = k23 + k24
End If
End If
Next s
br(18) = k23 '记录优先级净值
For s = 5 To kk '取优先份额的累计单位净值
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k25 = AK.Worksheets(file1).Cells(s, 2) '取出第2列的数值
If InStr(kemu, "累计单位净值") > 0 Then
If InStr(kemu, "优先级") > 0 Or InStr(kemu, "优先") > 0 Or InStr(kemu, "A类") > 0 Then
br(19) = k25 '记录单位净值
End If
End If
Next s
'次级相关数据提取
For s = 5 To kk '取次级份额
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k26 = AK.Worksheets(file1).Cells(s, 3) '取出第3列的数值
If InStr(kemu, "实收资本") > 0 Then
If InStr(kemu, "次级") > 0 Or InStr(kemu, "劣后") > 0 Or InStr(kemu, "风险级") > 0 Or InStr(kemu, "B类") > 0 Then
br(20) = k26 '记录次级份额
End If
End If
Next s
For s = 5 To kk '取次级净值
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k27 = AK.Worksheets(file1).Cells(s, 8) '取出第8列的数值
If InStr(kemu, "资产净值") > 0 Then
If InStr(kemu, "次级") > 0 Or InStr(kemu, "劣后") > 0 Or InStr(kemu, "风险级") > 0 Or InStr(kemu, "B类") > 0 Then
br(21) = k27 '记录次级净值
End If
End If
Next s
For s = 5 To kk '取次级份额的累计单位净值
kemu = AK.Worksheets(file1).Cells(s, 1) '取出第1列的科目代码
k28 = AK.Worksheets(file1).Cells(s, 2) '取出第2列的数值
If InStr(kemu, "累计单位净值") > 0 Then
If InStr(kemu, "次级") > 0 Or InStr(kemu, "劣后") > 0 Or InStr(kemu, "风险级") > 0 Or InStr(kemu, "B类") > 0 Then
br(8) = k28 '记录单位净值
End If
End If
Next s
Workbooks(file1 & ".xls").Close False
For j = 3 To 22
w1.Cells(i, j).Value = br(j - 1)
w1.Cells(i, 3) = br(2)
w1.Cells(i, 7) = br(17) / br(20) '份额杠杆
w1.Cells(i, 8) = br(18) / br(21) '净值杠杆
w1.Cells(i, 12) = w1.Cells(i, 11) - w1.Cells(i, 13) '交易所债券
w1.Cells(i, 14) = w1.Cells(i, 15) + w1.Cells(i, 16) + w1.Cells(i, 17) '现金资产
Next j
Next i
Application.ScreenUpdating = True
MsgBox "提取完成，请查看！"
End Sub
