Vba实现按选定类型排序标记

最新推荐文章于 2022-07-20 21:00:41 发布

啊东东_

最新推荐文章于 2022-07-20 21:00:41 发布

阅读量564

点赞数 1

分类专栏： VBA 文章标签：程序人生测试用例

本文链接：https://blog.csdn.net/h_XUYUAN/article/details/124649416

版权

VBA 专栏收录该内容

16 篇文章 4 订阅

订阅专栏

一、案例概述：
本案例主要实现的是在同一列数据中根据不同的类型筛选出成绩后三的数据，且将后三成绩进行颜色标记。

二、案例如下：
（1）源数据：我们要将业务型、发展中和开拓中语文成绩后三的数据筛选出来进行颜色标记。

（2）代码部分：

Sub shishi()
Application.ScreenUpdating = False
Dim A As Integer
Set 总表 = Sheets("Sheet1")
Set 字典 = CreateObject("Scripting.Dictionary")
最大行 = 总表.Range("A1").CurrentRegion.Rows.Count
arr1 = 总表.Range("A1").CurrentRegion
arr2 = Application.Index(arr1, 1)  'Application.Index(数组, 第几行，第几列)
For i = 5 To UBound(arr2)
    Sheets.Add(before:=Sheets(1)).Name = arr2(i) '创建学科工作表
    总表.Range("A1").Sort key1:="分部类型", order1:=xlAscending, key2:=arr2(i), order2:=xlAscending, Header:=xlYes
    '数组去重
    arr3 = 总表.Range("A2:A" & 最大行)
    For j = 1 To UBound(arr3)
        If Not 字典.Exists(arr3(j, 1)) Then
            字典(arr3(j, 1)) = ""
        End If
    Next
    '正片
    For Each k In 字典.keys()
        Sheets(arr2(i)).Cells(1, 1 + x) = k
        Sheets(arr2(i)).Cells(1, 1 + x).Resize(1, 2).Select
        Selection.Merge
        总表.Range("a1").CurrentRegion.AutoFilter
        总表.Range("a1").CurrentRegion.AutoFilter field:=1, Criteria1:=k
        总表.Columns(4).Copy Sheets(arr2(i)).Cells(2, 1 + x)
        'i决定第几列
        总表.Columns(i).Copy Sheets(arr2(i)).Cells(2, 1 + x + 1)
        Sheets(arr2(i)).Cells(2, 1 + x + 1) = "成绩"
        x = x + 3
    Next
    x = 0
    Sheets(arr2(i)).UsedRange.HorizontalAlignment = xlCenter
    总表.Range("a1").CurrentRegion.AutoFilter
Next

Application.ScreenUpdating = True
'筛选出不同类型分部 达成后三的数据
 Sheets("语文").Range("A6:H33").Clear
    For A = 2 To 119
        If Sheet1.Cells(A, 1) = Sheets("语文").Cells(1, 1) Then
            If Sheet1.Cells(A, 4) = Sheets("语文").Cells(3, 1) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(4, 1) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(5, 1) Then
                Sheet1.Cells(A, 5).Interior.Color = RGB(255, 0, 0)
            End If
        ElseIf Sheet1.Cells(A, 1) = Sheets("语文").Cells(1, 4) Then
             If Sheet1.Cells(A, 4) = Sheets("语文").Cells(3, 4) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(4, 4) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(5, 4) Then
                Sheet1.Cells(A, 5).Interior.Color = RGB(255, 0, 0)
            End If
            ElseIf Sheet1.Cells(A, 1) = Sheets("语文").Cells(1, 7) Then
             If Sheet1.Cells(A, 4) = Sheets("语文").Cells(3, 7) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(4, 7) Or Sheet1.Cells(A, 4) = Sheets("语文").Cells(5, 7) Then
                Sheet1.Cells(A, 5).Interior.Color = RGB(255, 0, 0)
            End If
            
            
        End If
    Next


End Sub

（3）结果呈现：