年会排节目单：检查同一个演员不会出现在连续的三个节目之中

这是一个excel VBA小程序，目的是检查演员名单不会出现在连续的三个节目之中。

这是样表：

首先，将原表格保存为带宏的格式.xlsm，然后Alt+F11调出VBA界面。

然后在相应的表格（和表单）中，创建module, 创建process (sub)。

运行的结果是，如果某个节目中的演员没有出现在后一、二、三个节目中，F列就会写上TRUE，否则为False，并且会把重复出现的演员的电子邮箱写在I列。

Sub DancerNotInNextThreePerformances()Dim verify As Booleanverify = True 'verify true means dancers are NOT in the next three rowsDim CellRef As RangeDim i As Integer'loopFor i = 2 To 19verify = TrueSet CellRef = Worksheets("verify").Range("D" & i)Worksheets("verify").Range("I" & i).Value = ""Dim DancerList1() As StringDancerList1 = Split(CellRef.Text, vbLf)Dim dancerStr As VariantDim dancer As StringDim DancerList2 As StringDancerList2 = Worksheets("verify").Range("D" & (i + 1)).TextDim DancerList3 As StringDancerList3 = Worksheets("verify").Range("D" & (i + 2)).TextDim DancerList4 As StringDancerList4 = Worksheets("verify").Range("D" & (i + 3)).TextFor Each dancerStr In DancerList1Dim in2, in3, in4 As Integerdancer = ExtractEmailFun(dancerStr)in2 = InStr(1, DancerList2, dancer, vbTextCompare)in3 = InStr(1, DancerList3, dancer, vbTextCompare)in4 = InStr(1, DancerList4, dancer, vbTextCompare)If in2 <> 0 Or in3 <> 0 Or in4 <> 0 Thenverify = FalseIf in2 <> 0 ThenWorksheets("verify").Range("I" & i).Value = dancer & " " & "D" & (i + 1)ElseIf in3 <> 0 ThenWorksheets("verify").Range("I" & i).Value = dancer & " " & "D" & (i + 2)ElseIf in4 <> 0 ThenWorksheets("verify").Range("I" & i).Value = dancer & " " & "D" & (i + 3)End IfEnd IfNext dancerStrWorksheets("verify").Range("F" & i).Value = verifyNext iDebug.Print "finish lala"
End Sub

这是其中使用到的提取电子邮箱的函数（function），摘自 How to quickly extract email address from text string?

Function ExtractEmailFun(ByVal extractStr As String) As String
'Update by extendoffice
Dim CharList As String
On Error Resume Next
CheckStr = "[A-Za-z0-9._-]"
OutStr = ""
Index = 1
Do While TrueIndex1 = VBA.InStr(Index, extractStr, "@")getStr = ""If Index1 > 0 ThenFor p = Index1 - 1 To 1 Step -1If Mid(extractStr, p, 1) Like CheckStr ThengetStr = Mid(extractStr, p, 1) & getStrElseExit ForEnd IfNextgetStr = getStr & "@"For p = Index1 + 1 To Len(extractStr)If Mid(extractStr, p, 1) Like CheckStr ThengetStr = getStr & Mid(extractStr, p, 1)ElseExit ForEnd IfNextIndex = Index1 + 1If OutStr = "" ThenOutStr = getStrElseOutStr = OutStr & Chr(10) & getStrEnd IfElseExit DoEnd If
Loop
ExtractEmailFun = OutStr
End Function

年会排节目单：检查同一个演员不会出现在连续的三个节目之中相关推荐

如何解决未经检查的演员表警告？
Eclipse给我以下形式的警告: 类型安全性:未经检查的从Object到HashMap的转换这是从对我无法控制返回对象的API的调用中得出的: HashMap<String, String& ...
SAP 同一个序列号可以同时出现在2个不同的HU里？
SAP 同一个序列号可以同时出现在2个不同的HU里? 答案是可以的. 如下图示,HU 180141003288里的序列号11810010540121, 而序列号11810010540121已经出现在另 ...
请检查下面的程序,找出其中的错误并改正,然后上机调试,使之能正常运行,从键盘输入,检查输出
1.请检查下面的程序,找出其中的错误(先不要上机,在纸面上作人工检查),并改正.然后上机调试,使之能正常运行.运行时从键盘输入时.分.秒的值,检查输出是否正确 2. 改写 1 中程序,要求: (1) ...
心电信号越界怎么回事_心慌胸闷到医院检查心电图却查不出问题，这到底咋回事？...
"近段时间我时不时会感到"心慌慌,心好像跳到嗓子眼",有时"胸口如有大石压住似的",可每次赶到医院做心电图检查时却又不发作了,啥也没查出来.这是怎么回 ...
在两个已经排好序的数组里找出第K小的数
前言: 这道题是一道非常常见的面试题,也是一道能够考察一个人的编程能力和算法的一道题.如果要求复杂度为 O(k), 是比较容易做出来的,但是,一般来讲,面试官要求给出更低复杂度的算法.网上有很多不同的 ...
indesign用于产品排班_InDesign必杀技，分分钟秒出方案排版（附ID排版模板）
原标题:InDesign必杀技,分分钟秒出方案排版(附ID排版模板) InDesign 一个用于专业排版的设计软件它提供自定义杂志.广告设计.目录. 零售商设计工作室和报纸出版方案虽然出道较晚, ...
Nacos 服务端健康检查及客户端服务订阅机制源码分析（三）
Nacos 服务端健康检查长连接概念:长连接,指在一个连接上可以连续发送多个数据包,在连接保持期间,如果没有数据包发送,需要双方发送链路检测包注册中心客户端 2.0 以后使用 gRPC 代替 h ...
vs dll必须和exe在同一个目录_Win10系统丢失 .dll 文件的三种解决方案教程
有时候开机或打开一个软件时,系统会提示无法启动程序,这是怎么回事呢?这是因为计算机丢失某个或某些dll文件,由于系统本身不存在这些运行库文件,需要进行添加才能使用该软件. 方法一:下载丢失的.dll文 ...
MiBioGen联盟倡议：综合分析人类基因组与菌群关系研究
Meta-analysis of human genome-microbiome association studies: the MiBioGen consortium initiative DOI ...

年会排节目单：检查同一个演员不会出现在连续的三个节目之中

年会排节目单：检查同一个演员不会出现在连续的三个节目之中相关推荐

最新文章

热门文章