VBA按座次排位（交错排座，向一侧或两侧排座，混合排座）

更新：先放一段公式吧。
有一位网友问我，如果只要交错排座，不需要向两侧排，怎样方便，我觉得，直接用公式就可以完成，不需要用代码，然后我就大概写了一个文件，如下：
在sheet1中，第一列是名单，第三列是写了每行的人数，如下图：

在sheet2中，B2单元格，写上公式：
=IF(OR(COLUMN()<=1,COLUMN()>1+Sheet1!$C2),"",IF((COLUMN()−1)>=(Sheet1!2),"",IF((COLUMN()-1)>=(Sheet1!2),"",IF((COLUMN()−1)>=(Sheet1!CKaTeX parse error: Expected 'EOF', got '&' at position 27: …RECT("SHEET1!R"&̲(ROW()-2)*Sheet…C2+(COLUMN()−1−(Sheet1!2+(COLUMN()-1-(Sheet1!2+(COLUMN()−1−(Sheet1!CKaTeX parse error: Expected 'EOF', got '&' at position 12: 2+1)/2)*2+2&̲"C1",FALSE),IND…C2+((Sheet1!2+((Sheet1!2+((Sheet1!C$2+1)/2-COLUMN()+1)*2)+1&“C1”,FALSE)))
然后向右，向下填充就是了

为了防止出现”0"，选中SHEET2的所有内容，按CTRL+1,单元格内容都设置成[=0]“”,如下图

昨天写了一个分组公式，把同事激动得以为所有排座位都可以用一个公式来完成，今天一早又说排座位，把整个会场分成3片，中间片是交错排列，左侧和右侧是向两边排列，画个图示意就是这样

让我写个公式，我说，这还真不是一个公式可以完成的，就写了几行代码，可以做到以下功能：
1、可以只设定中间区域，也就是会场所有人员按交错排列
2、可以只设定左边区域或右边区载，也就是所有人员统一从左向右排或从右向左排
3、可以混合排，就是按我同事的要求，先中间交错排，然后左侧从右向左排，再右侧从左向右排
大概界面是这样

分两个工作表，人员名单和座位表
在人员名单工作表中，A列是参会人员的姓名，B列一般是空的，如果临时不来，就填上几个字，改成非空就可以，在排座时就自动会跳过
D2-F2分别写左，中，右的人数，其中，中的位置填的是交错的人数，需要是偶数，左和右分别是顺序排列的人数
如果只要交错，就把左右填为0，如果只要双侧顺序，就把中填为0，如果只要单侧，就把中和左或中和右填为0就可以了
填完以后，点“排座”就可以了
排座的代码如下：

Function next_pos(intRow, intCol)'全长：2+左+1+中+1+右Dim new_Pos(3) '新行列坐标'左中右值l_Pos = Range("E2").Valuec_Pos = Range("F2").Valuer_Pos = Range("G2").Value'默认不变行new_Pos(0) = intRow'根据原座位，计算出下一位置'最左边Col=3,                       newCol=2+左+1+中+1+1If intCol = 3 Then'如果右侧为0           newCol=(2+左+1+中/2)+1 newRow=Row+1If r_Pos = 0 Thennew_Pos(1) = (2 + l_Pos + 1 + c_Pos / 2) + 1new_Pos(0) = intRow + 1new_Pos(2) = "中"Else'正常new_Pos(1) = 5 + l_Pos + c_Posnew_Pos(2) = "右"End If'左边3<Col<=2+左,                 newCol=Col-1ElseIf intCol <= 2 + l_Pos Thennew_Pos(1) = intCol - 1new_Pos(2) = "左"'中间最左Col=2+左+1+1,                newCol=2+左ElseIf intCol = 4 + l_Pos Then'如果左侧右侧为0               newCol=(2+左+1+中/2)+1 newRow=Row+1If l_Pos = 0 And r_Pos = 0 Thennew_Pos(1) = (2 + l_Pos + 1 + c_Pos / 2) + 1new_Pos(0) = intRow + 1new_Pos(2) = "中"'如果左侧为0                   newCol=2+左+1+中+1+1ElseIf l_Pos = 0 Thennew_Pos(1) = 5 + l_Pos + c_Posnew_Pos(2) = "右"'正常Elsenew_Pos(1) = 2 + l_Posnew_Pos(2) = "左"End If'中间左侧2+左+1+1<Col<=2+左+1+中/2    newCol=(2+左+1+中/2)+(2+左+1+中/2+1-Col)+1ElseIf intCol <= 3 + l_Pos + c_Pos / 2 Thennew_Pos(1) = (2 + l_Pos + 1 + c_Pos / 2) + (2 + l_Pos + 1 + c_Pos / 2 + 1 - intCol) + 1new_Pos(2) = "中"'中间右侧2+左+1+中/2<Col<=2+左+1+中   newCol=(2+左+1+中/2+1)-(Col-(2+左+1+中/2))ElseIf intCol <= 3 + l_Pos + c_Pos Thennew_Pos(1) = (2 + l_Pos + 1 + c_Pos / 2 + 1) - (intCol - (2 + l_Pos + 1 + c_Pos / 2))new_Pos(2) = "中"'右侧2+左+1+中<Col<2+左+1+中+1+右 newCol=Col+1ElseIf intCol < 4 + l_Pos + c_Pos + r_Pos Thennew_Pos(1) = intCol + 1new_Pos(2) = "右"'最右Col=2+左+1+中+1+右           newCol=(2+左+1+中/2)+1 newRow=Row+1ElseIf intCol = 4 + l_Pos + c_Pos + r_Pos Then'如果中有，则中If c_Pos > 0 Thennew_Pos(1) = (2 + l_Pos + 1 + c_Pos / 2) + 1new_Pos(0) = intRow + 1new_Pos(2) = "中"'如果中无，则左Elsenew_Pos(1) = 2 + l_Posnew_Pos(0) = intRow + 1new_Pos(2) = "左"End IfEnd Ifnext_pos = new_Pos
End FunctionSub 排序()'清空Sheets("排座表").Range("a1:zz10000").ClearSheets("座位").Range("a1:zz10000").Clear'左中右值l_Pos = Range("E2").Valuec_Pos = Range("F2").Valuer_Pos = Range("G2").Value'第一行Sheets("排座表").Cells(1, 2).Value = "过道"Sheets("排座表").Cells(1, 2 + l_Pos + 1).Value = "过道"Sheets("排座表").Cells(1, 2 + l_Pos + 1 + c_Pos + 1).Value = "过道"Sheets("座位").Cells(1, 1).Value = "姓名"Sheets("座位").Cells(1, 2).Value = "座位区域"For i = 1 To l_PosSheets("排座表").Cells(1, 2 + i).Value = iNextFor i = 1 To c_PosSheets("排座表").Cells(1, 2 + l_Pos + 1 + i).Value = iNextFor i = 1 To r_PosSheets("排座表").Cells(1, 2 + l_Pos + 1 + c_Pos + 1 + i).Value = iNext'第一个位置'如果中间有，就是中间，如果中间没有，就是左边，如果左边再没，就是右边'中：2+左+1+中/2+1'左：2+左'右：2+左+2If c_Pos > 0 ThenintRow = 2intCol = 2 + l_Pos + 1 + c_Pos / 2 + 1newPosPix = Array(intRow, intCol, "中")ElseIf l_Pos > 0 ThenintRow = 2intCol = 2 + l_PosnewPosPix = Array(intRow, intCol, "左")ElseMsgBox ("不能左侧和中间都为空")Exit SubEnd IfFor i = 2 To Cells(Rows.Count, 1).End(xlUp).RowIf Cells(i, 2) = "" ThenSheets("排座表").Cells(intRow, intCol).Value = Cells(i, 1).ValueSheets("排座表").Cells(intRow, 1).Value = "第" & intRow - 1 & "排"intSeatRow = Sheets("座位").Cells(Rows.Count, 1).End(xlUp).Row + 1Sheets("座位").Cells(intSeatRow, 1).Value = Cells(i, 1).ValueSheets("座位").Cells(intSeatRow, 2).Value = newPosPix(0) - 1 & "排" & newPosPix(2)newPosPix = next_pos(intRow, intCol)intRow = newPosPix(0)intCol = newPosPix(1)End IfNextMsgBox ("排座结束")
End Sub

VBA按座次排位（交错排座，向一侧或两侧排座，混合排座）相关推荐

java排班_使用java规则引擎Drools自动排班前言.doc
使用java规则引擎Drools自动排班前言使用java规则引擎Drools自动排班前言本文以一个经简化的运输车队自动排班需求为例,详细讲解了如何使用java规则引擎Drools进行商业规则的形式语 ...
计算机基础图文混排笔记,计算机基础知识与基本操作——图文混排课件.doc
文档介绍: Forpersonaluseonlyinstudyandresearch;mercialuse第25~28课次图文混排[本节要点]本节主要要求掌握图片的插入.图片格式的设置.图形的绘制.艺 ...
2021年门座式起重机司机试题及解析及门座式起重机司机复审考试
题库来源:安全生产模拟考试一点通公众号小程序门座式起重机司机试题及解析参考答案及门座式起重机司机考试试题解析由安全生产模拟考试一点通题库老师及门座式起重机司机操作证已考过的学员汇总,相对有效帮助门座 ...
干货 | 10分钟给上万客服排好班，携程大规模客服排班算法实践
作者简介博天,携程高级研发经理,关注大规模约束优化问题的建模和算法设计. 一.背景客户服务部门是携程以服务质量赢得客户信赖的基石,其拥有上万名一线的客服,每天进线量巨大:且伴随着业务量的起伏,每一 ...
java智能排线_网友晒别墅的智能家居排线铺满整面墙堪比数据中心
今天,有网友在小红书晒出了一座别墅的智能家居排线,只见蓝色管路足有四.五十根,密密麻麻的铺满了几乎整面墙. 很多网友第一次见到这种场面,纷纷评论: 我以为是墙/地暖-- 这特么疯了吧...在家开网吧? ...
c语言排班系统设计报告,C语言课程设计关于排班系统的一些问题
已结贴√ 问题点数:10 回复次数:5 C语言课程设计关于排班系统的一些问题小女大一,课程设计是百度排班系统(虽然不知老师干嘛现在布置类似小系统的作业),在论坛中找到个代码,其实只要交了代码就好,但 ...
矩形排样 matlab,二维多阶段矩形剪切排样算法(精).pdf
二维多阶段矩形剪切排样算法(精) 第32卷第5期计算机应用与软件 Vol32No．5 5 2015年5月 ComputerApplicationsandSoftware May201 二维多阶段矩 ...
c语言有一个已经排好的数组,C语言有一个已经排好序的数组。现输入一个数,要求按原来的规律将它插入数组中...
C语言有一个已经排好序的数组.现输入一个数,要求按原来的规律将它插入数组中 main() {inta[11]={1,4,6,9,13,16,19,28,40,100};inttemp1,temp2, ...
mysql 字段排重_MySQL 根据单个、多个字段排重
情景是这样的首先我们业务需要在一张流水表中需要进行流水的记录这个记录是从别的平台拉过来的数据但是他们数据无唯一约束即流水这样就很有可能出现单条数据重复的问题所以这种情况用join的话 ...
python编程试题单词倒排_Python:将句子中的单词全部倒排过来，但单词的字母顺序不变...
早上看到好友未央的一篇博文<一道google的测试工程师笔试题>,内容如下: 这是去年面试google测试工程师的一道题,题目如下: 设计一个函数,使用任意语言,完成以下功能: 一个句子, ...

VBA按座次排位（交错排座，向一侧或两侧排座，混合排座）

VBA按座次排位（交错排座，向一侧或两侧排座，混合排座）相关推荐

最新文章

热门文章