Sub 按钮1_Click()
Dim wb As Workbook
Dim sht As Worksheet, sht1 As Worksheet
Dim arr
Dim dic As Object
Application.ScreenUpdating = False
Set sht1 = ThisWorkbook.Sheets("排五遗漏数据")
For j = 3 To 15 Step 3sht1.Range(sht1.Cells(2, j - 1), sht1.Cells(11, j)).ClearContents
NextSet wb = Workbooks.Open(ThisWorkbook.path & "\排五.xlsx")
Set sht = wb.Sheets(1)
arr = sht.Range("a1").CurrentRegion
wb.Close Falsec = 3
For j = 2 To 6For k = 0 To 9For i = UBound(arr) To LBound(arr) + 1 Step -1If arr(i, j) * 1 = k Thensht1.Cells(k + 2, c) = UBound(arr) - isht1.Cells(k + 2, c - 1) = kExit ForEnd IfNextNextc = c + 3
Next
For j = 2 To 14 Step 3ActiveSheet.Sort.SortFields.ClearActiveSheet.Sort.SortFields.Add Key:=Range(Cells(2, j + 1), Cells(11, j + 1)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormalWith ActiveSheet.Sort.SetRange Range(Cells(1, j), Cells(11, j + 1)).Header = xlYes.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.ApplyEnd With
NextApplication.ScreenUpdating = TrueEnd Sub
下载源码链接：(https://download.csdn.net/download/weixin_43050480/87211884)
PS：亲自测10期可以中2期，最多的时候中4期
