[已解决]求助个股研报标题汇总显示,谢谢

jddsky · 发表于 2017-9-20 07:58

求助个股研报标题汇总显示,谢谢

最佳答案

月排行榜 / 总排行榜

wc110wc110

2017-9-21 10:28

Sub ceshi()
Dim i As Long, j As Long, i1 As Long, j1 As Long, szh As Long, szl As Long, arr As Variant
Dim sl As String, tt As Long
Dim gpdm As Variant, gpdm2 As Variant, gpdm3 As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
szh = Range("a2").CurrentRegion.Rows.Count
szl = Range("a2").CurrentRegion.Columns.Count
arr = Range(Cells(2, "a"), Cells(szh, szl))
Range(Cells(2, "a"), Cells(szh, szl)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, "a"), Cells(szh, "a")), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range(Cells(2, "a"), Cells(szh, szl))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
j = i + 1
i1 = 2
Do
If Cells(i, "a") = "" Then
Exit Do
End If
Do
If Cells(j, "a") = "" Then
Exit Do
End If
If Cells(i, "a") = Cells(j, "a") Then
j = j + 1
Else
Exit Do
End If
Loop
gpdm = Split(Cells(i, "a"), ".")
If Left(gpdm(0), 1) = 0 Or Left(gpdm(0), 1) = 3 Then
gpdm3 = "0" & "|" & gpdm(0) & "|"
ElseIf Left(gpdm(0), 1) = 6 Then
gpdm3 = "1" & "|" & gpdm(0) & "|"
End If
sl = ""
If i < j - 1 Then
For tt = 1 To 2
If tt = 1 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i") & ";"
ElseIf tt = 2 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i")
End If
sl = sl & gpdm2
i = i + 1
Next
ElseIf i = j - 1 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i")
sl = sl & gpdm2
i = i + 1
End If
Cells(i1, "n") = gpdm3 & sl & "|0"
i = j
j = i + 1
i1 = i1 + 1
Loop
Range(Cells(2, "a"), Cells(szh, szl)) = arr
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

复制代码

研报标题.zip (69.89 KB, 下载次数: 5)

jddsky · 发表于 2017-9-20 13:09

谢谢谢谢~~

wc110wc110 · 发表于 2017-9-20 17:59

输出结果可以按照股票代码从小到大排序吗

jddsky · 发表于 2017-9-20 19:45

wc110wc110 发表于 2017-9-20 17:59
输出结果可以按照股票代码从小到大排序吗

可以,怎么排序都可以

wc110wc110 · 发表于 2017-9-21 10:28

这个最佳答案由 wc110wc110 给出，感谢 wc110wc110 的回答。

单击隐藏图章

Sub ceshi()
Dim i As Long, j As Long, i1 As Long, j1 As Long, szh As Long, szl As Long, arr As Variant
Dim sl As String, tt As Long
Dim gpdm As Variant, gpdm2 As Variant, gpdm3 As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
szh = Range("a2").CurrentRegion.Rows.Count
szl = Range("a2").CurrentRegion.Columns.Count
arr = Range(Cells(2, "a"), Cells(szh, szl))
Range(Cells(2, "a"), Cells(szh, szl)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, "a"), Cells(szh, "a")), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range(Cells(2, "a"), Cells(szh, szl))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = 2
j = i + 1
i1 = 2
Do
If Cells(i, "a") = "" Then
Exit Do
End If
Do
If Cells(j, "a") = "" Then
Exit Do
End If
If Cells(i, "a") = Cells(j, "a") Then
j = j + 1
Else
Exit Do
End If
Loop
gpdm = Split(Cells(i, "a"), ".")
If Left(gpdm(0), 1) = 0 Or Left(gpdm(0), 1) = 3 Then
gpdm3 = "0" & "|" & gpdm(0) & "|"
ElseIf Left(gpdm(0), 1) = 6 Then
gpdm3 = "1" & "|" & gpdm(0) & "|"
End If
sl = ""
If i < j - 1 Then
For tt = 1 To 2
If tt = 1 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i") & ";"
ElseIf tt = 2 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i")
End If
sl = sl & gpdm2
i = i + 1
Next
ElseIf i = j - 1 Then
gpdm2 = Cells(i, "e") & "," & Cells(i, "i")
sl = sl & gpdm2
i = i + 1
End If
Cells(i1, "n") = gpdm3 & sl & "|0"
i = j
j = i + 1
i1 = i1 + 1
Loop
Range(Cells(2, "a"), Cells(szh, szl)) = arr
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

复制代码

研报标题.zip (69.89 KB, 下载次数: 5)

wc110wc110 · 发表于 2017-9-21 10:29

jddsky 发表于 2017-9-20 19:45
可以,怎么排序都可以

你看一下，如果正确请设置为最佳答案，谢谢

jddsky · 发表于 2017-9-25 20:51

wc110wc110 发表于 2017-9-21 10:28

谢谢~~

		自动登录	找回密码
密码			注册