精华内容
下载资源
问答
  • VBA 排序算法

    2019-05-13 15:45:39
    Sub 冒泡排序() Dim arr, temp, x, y, t, k t = Timer arr = Range("a1:a10") For x = 1 To UBound(arr) - 1 For y = x + 1 To UBound(arr) '只和当前数字下面的数进行比较 If arr(x, 1) > ar...

    递归算法
    '1 什么是递归?
    '递归就是自已调用自已。
    '2,用递归有什么好处?
    '简化代码,让程序更简捷。特别是在循环层数不定的情况下可以大大简单代码。
    '3,递归有什么坏处?
    '因为递归在使用时会产生大量储存临时信息的“栈”(按先进后出储存信息),所以运行效果比较低,所以一般不建议使用递归设计程序
    '2 例: 计算4的阶乘 (4 * 3 * 2 * 1 = 24)

    Sub 一般方法()
         Dim k, x
         k = 1
         For x = 4 To 1 Step -1
            k = k * x
         Next x
         MsgBox k
    End Sub
    

       Sub 递归1()
          MsgBox s(5)
       End Sub
       -----------------------------------
    '函数法
       Function s(n As Integer) As Integer
         If n = 1 Then
            s = 1
         Else
           s = n * s(n - 1)
         End If
       End Function
    

      Sub 递归2()
        k = 1
        s2 4
        MsgBox k
      End Sub
    'sub过程法
       Sub s2(n As Integer)
        ' Dim m
         If n > 0 Then
          k = k * n
         'm = n
          s2 n - 1
         End If
       End Sub
    

    '3 例:计算1+2+3+.5
     Sub 递归3()
       k = 0
       add5 1
       'MsgBox k
     End Sub
    

      Sub add5(n As Integer)
       If n < 5 Then
         k = k + n
         add5 n + 1
       End If
      End Sub
    

    Sub 冒泡排序()

    Dim arr, temp, x, y, t, k
         t = Timer
         arr = Range("a1:a10")
         
         For x = 1 To UBound(arr) - 1
           For y = x + 1 To UBound(arr) '只和当前数字下面的数进行比较
             If arr(x, 1) > arr(y, 1) Then '如果它大于它下面某一个数字
               temp = arr(x, 1)
               arr(x, 1) = arr(y, 1)
               arr(y, 1) = temp
             End If
           Next y
         Next x
         
         Range("b3").Resize(x) = ""
         Range("b3").Resize(x) = arr
         'Range("b2") = Timer - t
         MsgBox k
    End Sub
    
     -----------------------------------------------------------------
    Sub 冒泡排序演示()
        Dim arr, temp, x, y, t, k
         For x = 1 To 9
                                 Range("a" & x).Interior.ColorIndex = 3
           For y = x + 1 To 10  '只和当前数字下面的数进行比较
                                 Range("a" & y).Interior.ColorIndex = 4
             If Cells(x, 1) > Cells(y, 1) Then '如果它大于它下面某一个数字
               temp = Cells(x, 1)
               Cells(x, 1) = Cells(y, 1)
               Cells(y, 1) = temp
        2     End If
                                 Range("a" & y).Interior.ColorIndex = xlNone
           Next y
                                 Range("a" & x).Interior.ColorIndex = xlNone
                                 
         Next x
    
    End Sub
    

    选择排序

    Sub 选择排序()
      Dim arr, temp, x, y, t, iMax, k, k1, k2
      t = Timer
      arr = Range("a1:a10")
      
      For x = UBound(arr) To 1 + 1 Step -1
         iMax = 1 '最大的索引
         For y = 1 To x
              If arr(y, 1) > arr(iMax, 1) Then iMax = y
         Next y
         temp = arr(iMax, 1)
         arr(iMax, 1) = arr(x, 1)
         arr(x, 1) = temp
      Next x
      
      'Range("c3").Resize(UBound(arr)) = ""
      'Range("c3").Resize(UBound(arr)) = arr
      'Range("c2") = Timer - t
      'MsgBox k1
    End Sub
    --------------------------------------------------------------------
    Sub 选择排序单元格演示()
      Dim arr, temp, x, y, t, iMax, k, k1, k2
    
      For x = 10 To 2 Step -1
         iMax = 1
                           Range("a" & x).Interior.ColorIndex = 3
         For y = 1 To x
                           Range("a" & y).Interior.ColorIndex = 4
              If Cells(y, 1) > Cells(iMax, 1) Then
                           Range("a" & iMax).Interior.ColorIndex = xlNone
               iMax = y
              End If
                           Range("a" & y).Interior.ColorIndex = xlNone
                           Range("a" & iMax).Interior.ColorIndex = 6
                           
         Next y
         temp = Cells(iMax, 1)
         Cells(iMax, 1) = Cells(x, 1)
         Cells(x, 1) = temp
         Range("a" & x).Interior.ColorIndex = xlNone
         Range("a" & iMax).Interior.ColorIndex = xlNone
      Next x
    
    End Sub
    

    插入排序

    Sub 插入排序()
    Dim arr, temp, x, y, t, iMax, k, k1, k2
      t = Timer
      arr = Range("a1:a10")
      For x = 1 + 1 To UBound(arr)
      
         temp = arr(x, 1) '记得要插入的值
         
         For y = x - 1 To 1 Step -1
           If arr(y, 1) <= temp Then Exit For
           arr(y + 1, 1) = arr(y, 1)
           'k1 = k1 + 1
         Next y
         arr(y + 1, 1) = temp
         'k2 = k2 + 1
      Next
     ' Range("d3").Resize(UBound(arr)) = ""
     ' Range("d3").Resize(UBound(arr)) = arr
     'Range("d2") = Timer - t
     MsgBox k1
    End Sub
    -----------------------------------------------------------
    Sub 插入排序单元格演示()
    On Error Resume Next
      Dim arr, temp, x, y, t, iMax, k
      For x = 2 To 10
      
         temp = Cells(x, 1) '记得要插入的值
                   Range("A" & x).Interior.ColorIndex = 3
         For y = x - 1 To 1 Step -1
                   Range("A" & y).Interior.ColorIndex = 4
           If Cells(y, 1) <= temp Then Exit For
                   Cells(y + 1, 1) = Cells(y, 1)
                   Range("A" & y).Interior.ColorIndex = xlNone
         Next y
         Cells(y + 1, 1) = temp
                   Range("A" & y).Interior.ColorIndex = xlNone
                   Range("A" & x).Interior.ColorIndex = xlNone
      Next
    
    End Sub
    

    希尔排序

    Sub 希尔排序()
      Dim arr
      Dim 总大小, 间隔, x, y, temp, t
      t = Timer
      arr = Range("a1:a30")
      总大小 = UBound(arr) - LBound(arr) + 1
      间隔 = 1
      
      If 总大小 > 13 Then
         Do While 间隔 < 总大小
           间隔 = 间隔 * 3 + 1
         Loop
         间隔 = 间隔 \ 9
      End If
      
    '  Stop
    
      Do While 间隔
         For x = LBound(arr) + 间隔 To UBound(arr)
          temp = arr(x, 1)
          For y = x - 间隔 To LBound(arr) Step -间隔
             If arr(y, 1) <= temp Then Exit For
             arr(y + 间隔, 1) = arr(y, 1)
            ' k1 = k1 + 1
          Next y
          arr(y + 间隔, 1) = temp
         Next x
        间隔 = 间隔 \ 3
       Loop
       
      ' MsgBox k1
       'Range("e3").Resize(5000) = ""
        Range("d1").Resize(UBound(arr)) = arr
       'Range("e2") = Timer - t
    End Sub
    
    Sub 打乱顺序()
     Dim arr, temp, x
     arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
     
     For x = 1 To UBound(arr)
       num = Int(Rnd() * UBound(arr) + 1)
       temp = arr(num, 1)
       arr(num, 1) = arr(x, 1)
       arr(x, 1) = temp
     Next x
     
     Range("a1").Resize(x - 1) = arr
    End Sub
    ------------------------------------------------------------
    Sub 希尔排序单元格演示()
      Dim arr
      Dim 总大小, 间隔, x, y, temp, t
      t = Timer
      arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
      总大小 = UBound(arr) - LBound(arr) + 1
      间隔 = 1
      
      If 总大小 > 13 Then
         Do While 间隔 < 总大小
           间隔 = 间隔 * 3 + 1
         Loop
         间隔 = 间隔 \ 9
      End If
      
    '  Stop
    
      Do While 间隔
      
         For x = LBound(arr) + 间隔 To UBound(arr)
          temp = Cells(x, 1)
          Range("a" & x).Interior.ColorIndex = 3
          
          For y = x - 间隔 To LBound(arr) Step -间隔
              Range("a" & y).Interior.ColorIndex = 6
             If Cells(y, 1) <= temp Then Exit For
             Cells(y + 间隔, 1) = Cells(y, 1)
            ' k1 = k1 + 1
          Next y
          
          Cells(y + 间隔, 1) = temp
          Range("a1:a30").Interior.ColorIndex = xlNone
         Next x
        间隔 = 间隔 \ 3
       Loop
       
      ' MsgBox k1
       'Range("e3").Resize(5000) = ""
       ' Range("d1").Resize(UBound(arr)) = arr
       'Range("e2") = Timer - t
    End Sub
    

    快速排序

    Sub dd()
        Dim arr1(0 To 4999) As Long, arr, x, t
        t = Timer
        arr = Range("a1:a5000")
        For x = 1 To 5000
          arr1(x - 1) = arr(x, 1)
        Next x
        QuickSort arr1()
        Range("f2") = Timer - t
    End Sub
    Public Sub QuickSort(ByRef lngArray() As Long)
    
        Dim iLBound As Long
    
        Dim iUBound As Long
    
        Dim iTemp As Long
    
        Dim iOuter As Long
    
        Dim iMax As Long
       
    
        iLBound = LBound(lngArray)
    
        iUBound = UBound(lngArray)
    
        
    
        '若只有一个值,不排序
    
        If (iUBound - iLBound) Then
    
            For iOuter = iLBound To iUBound
    
                If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
    
            Next iOuter
    
            
    
            iTemp = lngArray(iMax)
    
            lngArray(iMax) = lngArray(iUBound)
    
            lngArray(iUBound) = iTemp
    
        
    
            '开始快速排序
    
            InnerQuickSort lngArray, iLBound, iUBound
    
        End If
        Range("f3").Resize(5000) = Application.Transpose(lngArray)
    
    End Sub
    
     
    
    Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)
    
        Dim iLeftCur As Long
    
        Dim iRightCur As Long
    
        Dim iPivot As Long
    
        Dim iTemp As Long
    
        
    
        If iLeftEnd >= iRightEnd Then Exit Sub
    
        
    
        iLeftCur = iLeftEnd
    
        iRightCur = iRightEnd + 1
    
        iPivot = lngArray(iLeftEnd)
    
        
    
        Do
    
            Do
    
                iLeftCur = iLeftCur + 1
    
            Loop While lngArray(iLeftCur) < iPivot
    
            
    
            Do
    
                iRightCur = iRightCur - 1
    
            Loop While lngArray(iRightCur) > iPivot
    
            
    
            If iLeftCur >= iRightCur Then Exit Do
    
            
    
            '交换值
    
            iTemp = lngArray(iLeftCur)
    
            lngArray(iLeftCur) = lngArray(iRightCur)
    
            lngArray(iRightCur) = iTemp
    
        Loop
    
        
    
        '递归快速排序
    
        lngArray(iLeftEnd) = lngArray(iRightCur)
    
        lngArray(iRightCur) = iPivot
    
        
    
        InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
    
        InnerQuickSort lngArray, iRightCur + 1, iRightEnd
    
    End Sub
    
    展开全文
  • 数字排序的方法有很多,最简单的方式可能就是下面两种方法了。 =SMALL($G29:29:29:G37,1*ROW(A1)-1+COLUMN(A1)) =SMALL(G29:G37,ROW(A1:A9)) 这两行代码虽然都是用了SMALL函数,原理也是一样的,但是实用性还是有很...

    数字排序的方法有很多,最简单的方式可能就是下面两种方法了。
    =SMALL($G 29 : 29: 29:G37,1*ROW(A1)-1+COLUMN(A1))
    =SMALL($G$29:G37,ROW(A1:A9))

    展开全文
  • 0).Value = sht.Name End If i = i + 1 Next End Sub 手动修改顺序 按照修改后的顺序进行排序 Sub ChangeOrder() Dim ar() As String '// sheet名数组 Dim i As Integer '// loop count Dim s As String '// cell值...

    获取当前sheet列表

    Sub GetSheetList()
        Dim sht     As Object       '// sheet
        Dim s       As String       '// 追加sheet名
        Dim i       As Long         '// loop count
        
        '// 追加sheet
        Call Sheets.Add(After:=Sheets(Sheets.Count))
        s = "AddSheet"
        ActiveSheet.Name = s
        ActiveSheet.Activate
        ActiveSheet.Range("A1").Select
        
        '// loop worksheet
        For Each sht In Sheets
            '// 不是追加sheet的场合
            If (sht.Name <> "AddSheet") Then
                '// 把sheet名拷贝到追加sheet
                ActiveCell.Offset(i, 0).Value = sht.Name
            End If
            
            i = i + 1
        Next
    End Sub
    

    在这里插入图片描述

    手动修改顺序

    在这里插入图片描述

    按照修改后的顺序进行排序

    Sub ChangeOrder()
        Dim ar()    As String       '// sheet名数组
        Dim i       As Integer      '// loop count
        Dim s       As String       '// cell值
        
        Sheets("AddSheet").Select
        Sheets("AddSheet").Activate
        Range("A1").Select
        
        i = 0
        ReDim ar(i)
        
        '// loop A列
        Do
            '// cell值取得
            s = ActiveCell.Offset(i, 0).Value
            
            '// cell值为空的场合
            If (s = "") Then
                '// 跳出loop
                Exit Do
            End If
            
            '// 把sheet名放到数组中
            ReDim Preserve ar(i)
            ar(i) = s
            
            i = i + 1
        Loop
        
        '// 按照AddSheet的顺序排列
        i = 0
        Do
            '// 数组要素为空
            If (i > UBound(ar)) Then
                '// 跳出loop
                Exit Do
            End If
            
            '// 将数组当前循环值的表名移动到当前循环计数器值的右侧
            Sheets(ar(i)).Move before:=Sheets(i + 1)
            
            i = i + 1
        Loop
        
        '// 删除的确认对话框不表示
        Application.DisplayAlerts = False
        
        '// "AddSheet"sheet删除
        Sheets("AddSheet").Delete
        
        Application.DisplayAlerts = True
    End Sub
    
    展开全文
  • * 二维数组根据某个字段排序 * @param $data 多维数组 * @param $index 需要排序的字段 * @param string $order 排序方式 默认 asc:顺序,desc:倒序 * @return mixed 排序后的二维数组 */ function array_...
    /**
     * 二维数组根据某个字段排序
     * @param $data 多维数组
     * @param $index 需要排序的字段
     * @param string $order 排序方式 默认 asc:顺序,desc:倒序
     * @return mixed 排序后的二维数组
     */
    function array_order($data, $index, $order = 'asc')
    {
        $index_array = array_column($data, $index);
        $order = strtoupper($order);
        array_multisort($index_array, $order == 'ASC' ? SORT_ASC : SORT_DESC, $data);
        return $data;
    }
    
    展开全文
  • 数组排序——VBA工作簿排序

    千次阅读 2018-10-19 16:54:43
    Sub OrderBy() Dim SheetCount As Long SheetCount = ThisWorkbook.Worksheets.Count - 1 ReDim SheetNameArray(SheetCount) Dim Index As Long Dim Names As String For Index = 0 To She...
  • 希尔排序法有点陌生了,学习!Option Explicit Sub 插入排序() Dim arr, temp, x, y, t, iMax, k, k1, k2 t = Timer arr = Range("a1:a10") For x = 2 To UBound(arr) temp = arr(x, 1) '记得要...
  • 在excel工作簿中对有多个工作表,由于个人需要,对每个工作表中某一值的比较大小后,然后进行排序。 由于vba中字典对应值比较难以排序,所以就分为两步 第一步是提取工作表名和对应字段写到工作表中: Sub ...
  • 并按大小排序,且以超大图标显示。 现只会用shell “explorer.exe D:\Image202101\”, vbNormalFocus 打开文件夹,请问后面的排序+超大图标显示该如何实现? 求指点,感谢!...
  • 每个工作表应包含按日期排列的股票报价器的有序列表,以便生成反映年度变化,变化百分比和总数量的总体摘要。 每个工作表应仅包含同一年的数据。 背景 该任务将使用VBA脚本分析真实的股市数据。 使用VBA,将生成...
  • Vba菜鸟教程

    万次阅读 多人点赞 2020-05-02 18:21:15
    文章目录Vba菜鸟教程编辑器宏vba基本语法运算符变量语句简写语句sub语句调用语句退出语句分支语句循环语句判断语句公式与函数在单元格输入公式利用单元格公式返回值调用工作表函数利用vba函数自定义函数操作对象操作...
  • VBA dialogs 调用对话框

    2021-11-03 12:05:43
    对话框 xlDialogPrinterSetup 9 【打印机设置】对话框 xlDialogArrangeAll 12 【全部重排】对话框 xlDialogWindowSize 13 【窗口大小】对话框 xlDialogWindowMove 14 【窗口移动】对话框 xlDialogRun 17 【运行】...
  • VBA常用技巧

    2014-12-21 16:39:28
    131-4 在Listview控件中排序 12 131-5 Listview控件的图标设置 12 技巧132 调用非模式窗体 12 技巧133 进度条的制作 12 133-1 使用进度条控件 12 133-2 使用标签控件 12 技巧134 使用TreeView控件显示层次 12 技巧...
  • Excel VBA 处理图形图表详解
  • Excel VBA技巧实例手册

    2016-07-28 22:29:39
    第1篇 ExcelVBA基础 第1章 了解Excel宏 1.1 创建宏 技巧001显示“开发工具”选项卡 技巧002录制第一个宏 技巧003在VBE中创建宏 1.2 管理宏 技巧004运行宏 技巧005编辑宏 技巧006保存宏 技巧007设置宏的安全性 第2...
  • 本窗体演示了VBA Treeview的一些功能。大多数选项可以在运行和更新 Treeview 属性时更改。在 Treeview 运行时更改 紫色 复选框将导致清除并重新创建 Treeview。 1.2 按钮说明 按钮标题 项 描述 ...
  • VBA dictionary的用法

    千次阅读 2019-10-10 21:35:04
    1.VBA中创建字典:用的是WSH引用。 dictionary是保存数据键和项目对的对象。 下面代码示范如何创建 Dictionary 对象: Dim myd As Object Set myd = CreateObject("Scripting.Dictionary") d.Add "a", "Athens...
  • VBA操作TXT文档

    千次阅读 2019-05-22 17:09:49
    要求输入xx.sh可以得到她后面的所有xx.sh,安装顺序排列,并且将这些xx.sh替换成Excel文档里面定义的序号; 成果物是EXCEL文件,所以本次想通过VBA语言来进行编写处理; VBA基础: 1、变量的定义:  ...
  • VBA编程技巧大全

    2013-08-05 09:03:19
    131-4 在Listview控件中排序 322 131-5 Listview控件的图标设置 323 技巧132 调用非模式窗体 326 技巧133 进度条的制作 328 133-1 使用进度条控件 328 133-2 使用标签控件 330 技巧134 使用TreeView控件显示层次 333...
  • 二、批量压缩图片 Word图片数量多,一定会导致整个文档体积非常大,那怎么压缩文档大小呢?很简单。 操作步骤: 随便双击Word其中一张图片,点击「格式」-「压缩图片」。 去掉「仅应用于此图片」选项,选择「电子...
  • VBA学习笔记2-数据结构类型ArrayList

    千次阅读 2019-12-28 18:02:53
    VBA学习笔记2-数据结构类型ArrayList一、这个东西是干什么的二、创建ArrayList1,前期绑定2,后期绑定三、常用方法和属性1,添加2,判断集合大小3,重点来了排序的办法3.1,升序排序3.2,降序排序4,复制集合的方法5...
  • VBA简述①(对象,属性,方法)

    千次阅读 2021-02-26 13:27:17
    何为VBA的对象 作为在进入基本语法之前必须知道的事情,VBA有“对象”的概念。“对象”是指在指示操作时,作为操作对象的“物”。在Excel的情况下,“工作簿”、“单元格”、“工作表”、“图表”、“表单”等都是...
  • 调试经验——VBA获取屏幕分辨率

    千次阅读 2018-07-17 23:34:09
    'SM_ARRANGE 设置windows如何排列最小化窗口的一个标志?参考api32.txt中的ARW常数 'SM_CLEANBOOT 指定启动模式。0=普通模式;1=带网络支持的安全模式 'SM_CMETRICS 可用系统环境的数量 'SM_CMOUSEBUTTON 鼠标按钮...
  • 原创批量图片排序功能,誉为“图片排版大师”,有21种样式可选,能批量将工作表中指定存储格范围的图片快速排序并输出到新表中。原创无穷加密与解密功能,能对选定的存储格或文本内容进行军方级加密保护,使其显示只...
  • word命令vba

    2020-04-16 20:00:42
    ”, vbYesNo) = vbYes Then With ActiveDocument .Password = “123456” .WritePassword = “123456” End With Else End If Else End If End Sub Sub Example() '根据文档字符数中重复频率排序字符并计数 '* ++...
  • VBA编程常用语句(转载) 1、Option Explicit '强制对模块内所有变量进行声明 Option Private Module '标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示 Option Compare Text '字符串不区分大小写 ...
  • Excel VBA 操作 Word(入门篇)

    万次阅读 多人点赞 2018-07-03 13:14:56
    原文地址本文的对象是:有一定Excel VBA基础,对Word VBA还没有什么认识,想在Excel中通过VBA操作Word还有困难的人。 一、新建Word引用需要首先创建一个对 Word Application 对象的引用。在VBA中,工具-引用,选取...
  • 这篇教程将教会你使用 CorelDRAW VBA代码在文档中创建美术字文本,并调用 FitTextToPath 方法让文本沿着形状的路径排列。 美术字文本是一种短文本,适合显示文字内容较少(通常是一行)的文本内容,可以给美术字...
  • VBA单元格、工作表、工作簿

    千次阅读 2019-04-30 23:08:35
    详解VBA单元格、工作表、工作簿各种表示、方法,注意事项。
  • VBA学习笔记3-数据结构类型SortedList

    千次阅读 2019-12-29 11:00:02
    VBA学习笔记3-数据结构类型SortedList一、SortedList是干什么的?二、创建方法1,前期绑定2,后期绑定三、常用方法和属性1,Add添加方法2,item的添加办法3,得到集合的大小4,判断key键和Item是否存在4.1,Contains...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 1,618
精华内容 647
关键字:

vba大小排序