【VBA实战】用Excel制作排序算法动画续

为什么会产生用excel来制作排序算法动画的念头,参见【VBA实战】用Excel制作排序算法动画一文。这篇文章贴出我所制作的所有排序算法动画效果和源码,供大家参考。

冒泡排序:

插入排序:

选择排序:

快速排序:

归并排序:

堆排序:

希尔排序:

完整源码如下。大家也可以直接从这儿下载。

Option Explicit
Public hmap As ObjectSub Sleep(t As Single)  ' T 参数的单位是 秒级Dim time1 As Singletime1 = TimerDoDoEvents '转让控制权,以便让操作系统处理其它的事件Loop While Timer - time1 < t  ' T 参数的单位是 秒级
End Sub'移动单元格
Sub CellMoveTo(rs As Integer, cs As Integer, re As Integer, ce As Integer)Worksheets("Sheet2").Cells(rs, cs).SelectSelection.CutWorksheets("Sheet2").Cells(re, ce).SelectActiveSheet.PasteEnd Sub'同一行两个单元格交换
Sub Swap(row As Integer, col1 As Integer, col2 As Integer)Call CellMoveTo(row, col1, row - 2, col1)Call Sleep(1)Call CellMoveTo(row, col2, row - 1, col2)Call Sleep(1)Dim i%, j%i = col1j = col2Do While i < col2Call CellMoveTo(row - 2, i, row - 2, i + 1)i = i + 1Call CellMoveTo(row - 1, j, row - 1, j - 1)j = j - 1Call Sleep(1)LoopCall CellMoveTo(row - 1, col1, row, col1)Call Sleep(1)Call CellMoveTo(row - 2, col2, row, col2)Call Sleep(1)End Sub'堆的节点交换,只交换数字
Sub HeapSwap(c1 As String, c2 As String)Dim n%Dim clr1 As Long, clr2 As Long, clrf As Longclr1 = 5287936clr2 = 49407Call Color2(c1, clr2)Call Color2(c2, clr2)n = Worksheets("Sheet2").Range(c1).ValueWorksheets("Sheet2").Range(c1).Value = Worksheets("Sheet2").Range(c2).ValueWorksheets("Sheet2").Range(c2).Value = nCall Sleep(1)Call Color2(c1, clr1)Call Color2(c2, clr1)End SubSub Color(row As Integer, col As Integer, clr As Long)Worksheets("Sheet2").Cells(row, col).SelectWith Selection.Interior.Pattern = xlSolid.PatternColorIndex = xlAutomatic.Color = clr.TintAndShade = 0.PatternTintAndShade = 0End With
End SubSub Color1(row As Integer, col As Integer, clr As Long)Call Color(row, col, clr)Call Sleep(1)End SubSub Color2(c As String, clr As Long)Worksheets("Sheet2").Range(c).SelectWith Selection.Interior.Pattern = xlSolid.PatternColorIndex = xlAutomatic.Color = clr.TintAndShade = 0.PatternTintAndShade = 0End WithCall Sleep(1)
End SubSub InitData()Dim clr1 As Longclr1 = 5287936Set hmap = CreateObject("Scripting.Dictionary")hmap.Add 5, "M10"hmap.Add 6, "I14"hmap.Add 7, "Q14"hmap.Add 8, "F17"hmap.Add 9, "L17"hmap.Add 10, "N17"hmap.Add 11, "T17"hmap.Add 12, "D19"hmap.Add 13, "H19"hmap.Add 14, "J19"Dim row%, j%row = 7For j = 5 To 14Dim n%n = Int(100 * Rnd)Worksheets("Sheet2").Cells(row, j) = nCall Color(row, j, clr1)Worksheets("Sheet2").Range(hmap.Item(j)).Value = nWorksheets("Sheet2").Range(hmap.Item(j)).SelectSelection.Interior.Color = clr1Next j
End Sub'堆排序Sub Adjust(r As Integer, last As Integer)Dim f1%, f2%, v1%, v2%, row%Dim clr1 As Long, clr2 As Long, clrf As Longclr1 = 5287936clr2 = 49407clrf = 15773696row = 7f1 = 5 + (r - 5) * 2 + 1f2 = 5 + (r - 5) * 2 + 2v1 = -1v2 = -1If f1 <= last Thenv1 = Worksheets("Sheet2").Cells(row, f1).ValueEnd IfIf f2 <= last Thenv2 = Worksheets("Sheet2").Cells(row, f2).ValueEnd IfIf Worksheets("Sheet2").Cells(row, r) < v1 Or Worksheets("Sheet2").Cells(row, r) < v2 ThenDim s%If v1 > v2 Thens = f1Elses = f2End IfCall Color1(row, r, clr2)Call Color1(row, s, clr2)Call Swap(row, r, s)Call Color1(row, r, clr1)Call Color1(row, s, clr1)Call HeapSwap(hmap.Item(r), hmap.Item(s))Call Adjust(s, last)End IfEnd SubSub HeapSort()Dim i%, j%, row%, last%Dim clr1 As Long, clr2 As Long, clrf As Longrow = 7clr1 = 5287936clr2 = 49407clrf = 15773696last = 14For i = 14 To 6 Step -1Dim t%t = 5 + Int((i - 6) / 2)Call Color1(row, i, clr2)Call Color1(row, t, clr2)If Worksheets("Sheet2").Cells(row, i).Value > Worksheets("Sheet2").Cells(row, t).Value ThenCall Swap(row, t, i)Call HeapSwap(hmap.Item(t), hmap.Item(i))Call Adjust(i, last)End IfCall Color1(row, i, clr1)Call Color1(row, t, clr1)Next iFor i = 14 To 6 Step -1Call Color1(row, 5, clr2)Call Color1(row, i, clr2)Call Swap(row, 5, i)Call Color1(row, 5, clr1)Call Color1(row, i, clrf)Call HeapSwap(hmap.Item(5), hmap.Item(i))Call Color2(hmap.Item(i), clrf)last = last - 1Call Adjust(5, last)Next iCall Color1(row, 5, clrf)Call Color2(hmap.Item(5), clrf)
End Sub'希尔排序
Sub ShellSort()Dim i%, j%, row%, gap%, tmp%Dim clr1 As Long, clr2 As Long, clrf As Longrow = 7clr1 = 5287936clr2 = 49407clrf = 15773696gap = 5Do While gap > 0For i = 5 + gap To 14tmp = Worksheets("Sheet2").Cells(row, i).ValueCall Color1(row, i, clr2)Call CellMoveTo(row, i, row - 2, i)Call Sleep(1)For j = i - gap To 5 Step -gapCall Color1(row, j, clr2)If tmp < Worksheets("Sheet2").Cells(row, j).Value ThenCall CellMoveTo(row, j, row, j + gap)Call Sleep(1)Call Color1(row, j + gap, clr1)Call CellMoveTo(row - 2, j + gap, row - 2, j)Call Sleep(1)ElseCall Color1(row, j, clr1)Exit ForEnd IfNext jCall CellMoveTo(row - 2, j + gap, row, j + gap)Call Sleep(1)Call Color1(row, j + gap, clr1)Next igap = Int(gap / 2)LoopEnd Sub'归并排序
Sub Merge(s1 As Integer, e1 As Integer, s2 As Integer, e2 As Integer)Dim i%, j%, p%, row%Dim clr1 As Long, clr2 As Long, clr3 As Long, clrf As Longrow = 7clr1 = 5287936clr2 = 49407clr3 = 65535clrf = 15773696For i = s1 To e1Call Color(row, i, clr2)Next iFor i = s2 To e2Call Color(row, i, clr3)Next iCall Sleep(1)i = s1j = s2p = s1Do While i <= e1 And j <= e2Do While i <= e1 And Worksheets("Sheet2").Cells(row, i).Value <= Worksheets("Sheet2").Cells(row, j).ValueCall CellMoveTo(row, i, row - 2, p)Call Sleep(1)p = p + 1i = i + 1LoopDo While j <= e2 And Worksheets("Sheet2").Cells(row, j).Value < Worksheets("Sheet2").Cells(row, i).ValueCall CellMoveTo(row, j, row - 2, p)Call Sleep(1)p = p + 1j = j + 1LoopLoopDo While i <= e1Call CellMoveTo(row, i, row - 2, p)Call Sleep(1)p = p + 1i = i + 1LoopDo While j <= e2Call CellMoveTo(row, j, row - 2, p)Call Sleep(1)p = p + 1j = j + 1LoopFor i = s1 To e2Call Color(row - 2, i, clr1)Call CellMoveTo(row - 2, i, row, i)Next iCall Sleep(1)End SubSub MergeSort2(left As Integer, right As Integer)Dim mid%If left >= right ThenExit SubEnd Ifmid = Int((left + right) / 2)Call MergeSort2(left, mid)Call MergeSort2(mid + 1, right)Call Merge(left, mid, mid + 1, right)End SubSub MergeSort()Call MergeSort2(5, 14)
End Sub'快速排序
Sub QuickSort(low As Integer, high As Integer)Dim left%, right%, mend%, row%, i%Dim clr1 As Long, clr2 As Long, clr3 As Long, clrf As Longmend = 14row = 7clr1 = 5287936clr2 = 49407clr3 = 65535clrf = 15773696For i = low To highCall Color(row, i, clr3)Next iCall Sleep(1)If low >= high ThenIf low = high ThenCall Color1(row, low, clrf)End IfExit SubEnd Ifleft = low + 1right = highCall Color1(row, low, clrf)Do While left <= rightCall Color1(row, left, clr2)Do While left <= right And Worksheets("Sheet2").Cells(row, left).Value <= Worksheets("Sheet2").Cells(row, low).ValueCall Color1(row, left, clr1)left = left + 1If left <= right ThenCall Color1(row, left, clr2)End IfLoopCall Color1(row, right, clr2)Do While left <= right And Worksheets("Sheet2").Cells(row, right).Value > Worksheets("Sheet2").Cells(row, low).ValueCall Color1(row, right, clr1)right = right - 1If right >= left ThenCall Color1(row, right, clr2)End IfLoopIf left < right ThenCall Color(row, right, clr2)Call Swap(row, left, right)Call Color(row, left, clr3)Call Color(row, right, clr3)Call Sleep(1)End IfLoopIf low <> left - 1 ThenCall Swap(row, low, left - 1)End IfCall QuickSort(low, left - 2)Call QuickSort(left, high)
End SubSub QuickSort2()Call QuickSort(5, 14)
End Sub'选择排序
Sub SelectionSort()Dim i%, j%, min%, row%Dim clr1 As Long, clr2 As Long, clrf As Long'mend = 14row = 7clr1 = 5287936clr2 = 49407clrf = 15773696For i = 5 To 13min = iCall Color1(row, min, clrf)For j = i + 1 To 14Call Color(row, j, clr2)Call Sleep(1)If Worksheets("Sheet2").Cells(row, j).Value < Worksheets("Sheet2").Cells(row, min).Value ThenCall Color1(row, j, clrf)Call Color1(row, min, clr1)min = jElseCall Color1(row, j, clr1)End IfNext jIf min <> i ThenCall Swap(row, i, min)Call Sleep(1)End IfNext iCall Color(row, 14, clrf)
End Sub'插入排序
Sub InsertSort()Dim i%, j%, row%, tmp%Dim clr1 As Long, clr2 As Long, clrf As Longrow = 7clr1 = 5287936clr2 = 49407clrf = 15773696For i = 6 To 14tmp = Worksheets("Sheet2").Cells(row, i).ValueCall Color1(row, i, clr2)Call CellMoveTo(row, i, row - 1, i)Call Sleep(1)For j = i - 1 To 5 Step -1Call Color1(row, j, clr2)If tmp < Worksheets("Sheet2").Cells(row, j).Value ThenCall CellMoveTo(row, j, row, j + 1)Call Sleep(1)Call Color1(row, j + 1, clr1)Call CellMoveTo(row - 1, j + 1, row - 1, j)Call Sleep(1)ElseCall Color1(row, j, clr1)Exit ForEnd IfNext jCall CellMoveTo(row - 1, j + 1, row, j + 1)Call Sleep(1)Call Color1(row, j + 1, clr1)Next iEnd Sub'冒泡排序
Sub BubbleSort()Dim i%, j%, mend%, row%Dim clr1 As Long, clr2 As Long, clrf As Longmend = 14row = 7clr1 = 5287936clr2 = 49407clrf = 15773696For i = 5 To 13For j = 5 To mend - 1Call Color(row, j, clr2)Call Color(row, j + 1, clr2)Call Sleep(1)If Worksheets("Sheet2").Cells(row, j).Value > Worksheets("Sheet2").Cells(row, j + 1).Value ThenCall Swap(row, j, j + 1)End IfCall Color(row, j, clr1)Call Color(row, j + 1, clr1)Call Sleep(1)Next jCall Color(row, mend, clrf)mend = mend - 1Call Sleep(1)Next iCall Color(row, mend, clrf)End Sub

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.rhkb.cn/news/470532.html

如若内容造成侵权/违法违规/事实不符,请联系长河编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

IPguard与Ping32全面对比——选择最适合企业的数据安全解决方案

在如今数据安全威胁日益加剧的时代&#xff0c;企业必须高度重视保护敏感数据与信息。因此&#xff0c;选择一款合适的数据安全软件&#xff0c;尤其是防泄密和信息保护软件&#xff0c;显得尤为重要。在市场上&#xff0c;有两款备受企业青睐的数据安全解决方案——IPguard和P…

《情商》提升:增强自我意识,学会与情绪共处

在当今社会&#xff0c;情商&#xff08;Emotional Intelligence&#xff0c;EQ&#xff09;的重要性越来越受到人们的关注。情商是指个体运用情绪、情感、认知和行为反应的能力&#xff0c;来理解、管理、表达和处理情感的一种综合素养。情商的高低对于个人的成长、人际关系、…

k8s集群安装(kubeadm)

k8s集群安装&#xff08;kubeadm&#xff09; 1、环境准备&#xff08;master和node节点都执行&#xff09;1.1、替换yum源1.2、关闭selinux1.3、永久关闭防火墙1.4、永久关闭swap1.5、修改主机名添加host1.6、时间同步1.7、将桥接的IPv4流量传递到iptables的链1.8、docker安装…

使用Matlab建立随机森林

综述 除了神经网络模型以外&#xff0c;树模型及基于树的集成学习模型是较为常用的效果较好的预测模型。我们以下构建一个随机森林模型。 随机森林是一种集成学习方法&#xff0c;通过构建多个决策树并结合其预测结果来提高模型的准确性和稳定性。在MATLAB中&#xff0c;可以…

Wireshark

目录 解题思路 题目设计原理 总结 解题思路 首先下载文件&#xff0c;用 wireshark 打开一头雾水。 但是看看题目的提示&#xff0c;说管理员的密码就是 flag 的内容&#xff0c;我们可以知道&#xff0c;关键词估计是密码&#xff0c;passwd、password、pwd之类的。 所以我…

FreeRTOS学习13——任务相关API函数

任务相关API函数 任务相关API函数任务相关API函数介绍任务相关 API 函数详解函数 uxTaskPriorityGet()函数 vTaskPrioritySet()函数 uxTaskGetSystemState()函数 vTaskGetInfo()函数 xTaskGetApplicationTaskTag()函数 xTaskGetCurrentHandle()函数 xTaskGetHandle()函数 xTask…

使用kalibr_calibration标定相机(realsense)和imu(h7min)

vslam-evaluation/VINS/Installation documentation/4.IMU和相机联合标定kalibr_calibration.md at master DroidAITech/vslam-evaluation GitHub 目录 1.kalibr安装 1.1安装依赖项 1.2创建工作空间 1.3下载kalibr并编译 1.4设置环境变量 2.准备标定板 3.配置驱动和打…

[Docker#8] 容器配置 | Mysql | Redis | C++ | 资源控制 | 命令对比

目录 一&#xff1a;Mysql 容器化安装 二&#xff1a;Redis 容器化安装 Redis 简介 Redis 容器创建 三&#xff1a;C容器制作 四&#xff1a;容器资源更新 常见问题 一&#xff1a;Mysql 容器化安装 进入 mysql 的镜像网站&#xff0c;查找 mysql 的镜像 mysql docker…

1小时构建Vue3知识体系之vue的生命周期函数

本文转载自&#xff1a;https://fangcaicoding.cn/course/12/63 大家好&#xff01;我是方才&#xff0c;目前是8人后端研发团队的负责人&#xff0c;拥有6年后端经验&3年团队管理经验。 系统学习践行者&#xff01;近期在系统化输出前端入门相关技术文章&#xff0c;期望能…

数据结构-集合

一.集合的表示 一个重要的操作是查某个元素属于哪个集合&#xff0c;另一个操作是合并操作 从这个树的节点去找树根也就是从下往上找,要把树并起来只需把两个根并在一起就可以了 不存在已知一个节点去找孩子节点&#xff0c;根重要的是已知一个节点找它的父亲节点,与之前的二…

unity基础,点乘叉乘。

简单记录下点乘叉乘&#xff0c;要不每次用完就忘&#xff0c;忘了又查。 using System.Collections; using System.Collections.Generic; using UnityEngine;public class TestCrossDot : MonoBehaviour {/// <summary>/// 原点/// </summary>public Transform t…

springboot 之 整合springdoc2.6 (swagger 3)

版本 springboot 3.3.5 jdk 17 springdoc 2.6.0 依赖pom <dependency><groupId>org.springdoc</groupId><artifactId>springdoc-openapi-starter-webmvc-ui</artifactId><version>2.6.0</version> </dependency>注解对比…

数据结构与算法-前缀和数组

前缀和问题 什么是前缀和? 对于一个一般数组 nums,如果我们需要知道 S1 nums[0] nums[1]的结果&#xff0c; S2 nums[0] nums[1] nums[2] … 计算公式相当于: S2 S1 nums[2] … Sn Sn-1 nums[n]; 所谓前缀和&#xff1a;用来记录数组前项和的一个新数组&#xff0c;提…

R语言机器学习与临床预测模型77--机器学习预测常用R语言包

R小盐准备介绍R语言机器学习与预测模型的学习笔记 你想要的R语言学习资料都在这里&#xff0c; 快来收藏关注【科研私家菜】 01 预测模型常用R包 常见回归分析包: rpart 包含有分类回归树的方法; earth 包可以实现多元自适应样条回归; mgev包含广义加性模型回归; Rweka 包中的M…

Elasticsearch可视化工具Elasticvue插件用法

目录 1.打开浏览器扩展程序(示例Edge浏览器) ​2.搜索elasticvue并安装 3.打开elasticvue ​4.连接Es 5.有些浏览器无法下载安装扩展&#xff0c;例如谷歌。可以打包扩展给别的浏览器使用。 5.1打开浏览器扩展&#xff0c;打开开发人员模式&#xff0c;记住扩展程序id 5…

大数据技术之HBase中的HRegion

如果你正在学习大数据&#xff0c;你应该知道HBase是一个列式存储的NoSQL分布式数据库&#xff0c;可以配合Hadoop来使用。今天自己简单做了几页PPT&#xff0c;解释了一下HBase当中HRegion的基本概念&#xff0c;很多初学者在学习的时候对HRegion这个概念一直懵懵懂懂&#xf…

Spring Cloud Contract快速入门Demo

1.什么是Spring Cloud Contract &#xff1f; Spring Cloud Contract 是 Spring 提供的一套工具&#xff0c;用于帮助开发者通过契约&#xff08;Contract&#xff09;驱动的方式进行微服务的测试和集成。它主要解决微服务之间通信时&#xff0c;如何确保服务提供者和消费者之…

GISBox VS ArcGIS:分别适用于大型和小型项目的两款GIS软件

在现代地理信息系统&#xff08;GIS&#xff09;领域&#xff0c;有许多大家耳熟能详的GIS软件。它们各自具有独特的优势&#xff0c;适用于不同的行业需求和使用场景。在众多企业和开发者面前&#xff0c;如何选择合适的 GIS 软件成为了一个值得深入思考的问题。今天&#xff…

Linux 进程线程间通信总结

线程 线程共享存储空间主要带来的问题是数据同步和互斥。由于线程在同一进程中运行&#xff0c;它们共享相同的内存空间&#xff0c;任何线程都可以访问共享数据。这样&#xff0c;多个线程并发执行时&#xff0c;可能会导致以下两种主要问题&#xff1a; 互斥问题&#xff0…

【再谈设计模式】抽象工厂模式~对象创建的统筹者

一、引言 在软件开发的世界里&#xff0c;高效、灵活且易于维护的代码结构是每个开发者追求的目标。设计模式就像是建筑蓝图中的经典方案&#xff0c;为我们提供了应对各种常见问题的有效策略。其中&#xff0c;抽象工厂模式在对象创建方面扮演着重要的角色&#xff0c;它如同一…