Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4005|回复: 16

[已解决]将学生对应排布到各个床位

[复制链接]
发表于 2015-10-9 13:47 | 显示全部楼层 |阅读模式
本帖最后由 爱疯 于 2015-10-11 21:44 编辑

代码有问题,请老师帮助修改
最佳答案
2015-10-12 09:48
针对楼上代码小改了一下,加上了随机排的功能。
  1. Sub test()
  2.     Dim arr, brr
  3.     Dim i&, j&, k&
  4.     Dim lRow&, iCol%

  5.     With Sheets("sheet1")
  6.         org = .Range("ad1").CurrentRegion.Value   '原序名单
  7.         .Range("af2:af" & UBound(org)).Formula = "=rand()"  '辅助列(随机数)
  8.         .Range("ad2:af" & UBound(org)).Sort key1:=.[af2]   '按辅助列排序
  9.         .[af:af].ClearContents      '清除辅助列
  10.         arr = .Range("ad1").CurrentRegion.Value      '乱序名单
  11.         .Range("ad1").CurrentRegion.Value = org       '恢复原序
  12.         lRow = .Range("b" & Rows.Count).End(3).Row
  13.         brr = .Range("c2:l" & lRow).Value


  14.         For i = 1 To UBound(brr) Step 3
  15.             For j = 1 To 10
  16.                 If brr(i, j) <> "" Then
  17.                     k = k + 1
  18.                     xm = arr(k + 1, 2)  '姓名
  19.                     iCol = InStr(xm, "男")
  20.                     brr(i + 1, j) = Left(xm, iCol - 1)
  21.                     brr(i + 2, j) = Mid(xm, iCol + 1)
  22.                 End If
  23.             Next
  24.         Next

  25.         .Range("c2").Resize(UBound(brr), 10) = brr
  26.     End With
  27. End Sub
复制代码

本.zip

111.61 KB, 下载次数: 35

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2015-10-9 14:22 | 显示全部楼层
本帖最后由 fjmxwrs 于 2015-10-9 14:25 编辑

有什么问题?请说明你要按什么规则排,一句话也没有,猜不到你是什么意思
回复

使用道具 举报

 楼主| 发表于 2015-10-9 18:02 | 显示全部楼层
本帖最后由 FGHUIOCXZVBMN 于 2015-10-9 18:16 编辑
fjmxwrs 发表于 2015-10-9 14:22
有什么问题?请说明你要按什么规则排,一句话也没有,猜不到你是什么意思

对不起,我欠考虑。是按房间的床位排,首先是按实际设定了每个房间的床位后,再将学生对应排布到各个床位。不知说清了没有,有烦了

表中AD列原本是班级,但运行程序后出现漏排,为查找方便,所以改成了自然数。班级号与每一个姓名后的数是一样的。
回复

使用道具 举报

发表于 2015-10-9 20:37 | 显示全部楼层
FGHUIOCXZVBMN 发表于 2015-10-9 18:02
对不起,我欠考虑。是按房间的床位排,首先是按实际设定了每个房间的床位后,再将学生对应排布到各个床位 ...

还是没有太明白,按房间排满?
回复

使用道具 举报

 楼主| 发表于 2015-10-10 10:01 | 显示全部楼层
本帖最后由 FGHUIOCXZVBMN 于 2015-10-10 10:07 编辑
fjmxwrs 发表于 2015-10-9 20:37
还是没有太明白,按房间排满?

在每间房间的“床位”字段行中标有数字的是床位号,空白的是不能用的床,例如“101”房间2号到8号6个床位能用。而空白的1号,9号,10号这三个床位不能用,故不能安排,也就以此清除了床位号。运行程序自动排列的目的是要将AD列的班级(这里已改成了自然数)和AE列的姓名自动对应的由左到右横向的逐个排满有床位的房间
     我现在这个代码导致的问题是:1是漏排;2是行错位。
回复

使用道具 举报

 楼主| 发表于 2015-10-11 16:47 | 显示全部楼层
FGHUIOCXZVBMN 发表于 2015-10-10 10:01
在每间房间的“床位”字段行中标有数字的是床位号,空白的是不能用的床,例如“101”房间2号到8号6个床位 ...

请问老师,能帮助解决吗?
回复

使用道具 举报

发表于 2015-10-12 09:27 | 显示全部楼层
你的名单里已经组合了姓名+性别+班级?
  1. Sub test()
  2.     Dim arr, brr
  3.     Dim i&, j&, k&
  4.     Dim lRow&, iCol%

  5.     With Sheets("sheet1")
  6.         arr = .Range("ad1").CurrentRegion.Value
  7.         lRow = .Range("b" & Rows.Count).End(3).Row
  8.         brr = .Range("c2:l" & lRow).Value


  9.         For i = 1 To UBound(brr) Step 3
  10.             For j = 1 To 10
  11.                 If brr(i, j) <> "" Then
  12.                     k = k + 1
  13.                     iCol = InStrRev(arr(k + 1, 2), "男")
  14.                     brr(i + 1, j) = Left(arr(k + 1, 2), iCol - 1)
  15.                     brr(i + 2, j) = Right(arr(k + 1, 2), Len(arr(k + 1, 2)) - iCol)
  16.                 End If
  17.             Next
  18.         Next

  19.         .Range("c2").Resize(UBound(brr), 10) = brr
  20.     End With
  21. End Sub
复制代码
回复

使用道具 举报

发表于 2015-10-12 09:48 | 显示全部楼层    本楼为最佳答案   
针对楼上代码小改了一下,加上了随机排的功能。
  1. Sub test()
  2.     Dim arr, brr
  3.     Dim i&, j&, k&
  4.     Dim lRow&, iCol%

  5.     With Sheets("sheet1")
  6.         org = .Range("ad1").CurrentRegion.Value   '原序名单
  7.         .Range("af2:af" & UBound(org)).Formula = "=rand()"  '辅助列(随机数)
  8.         .Range("ad2:af" & UBound(org)).Sort key1:=.[af2]   '按辅助列排序
  9.         .[af:af].ClearContents      '清除辅助列
  10.         arr = .Range("ad1").CurrentRegion.Value      '乱序名单
  11.         .Range("ad1").CurrentRegion.Value = org       '恢复原序
  12.         lRow = .Range("b" & Rows.Count).End(3).Row
  13.         brr = .Range("c2:l" & lRow).Value


  14.         For i = 1 To UBound(brr) Step 3
  15.             For j = 1 To 10
  16.                 If brr(i, j) <> "" Then
  17.                     k = k + 1
  18.                     xm = arr(k + 1, 2)  '姓名
  19.                     iCol = InStr(xm, "男")
  20.                     brr(i + 1, j) = Left(xm, iCol - 1)
  21.                     brr(i + 2, j) = Mid(xm, iCol + 1)
  22.                 End If
  23.             Next
  24.         Next

  25.         .Range("c2").Resize(UBound(brr), 10) = brr
  26.     End With
  27. End Sub
复制代码

评分

参与人数 1 +9 收起 理由
金樽空对月 + 9 很给力!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2015-10-12 12:06 | 显示全部楼层
grf1973 发表于 2015-10-12 09:48
针对楼上代码小改了一下,加上了随机排的功能。

刚打开电脑,看到有了回复,真高兴,真谢谢老师了
回复

使用道具 举报

 楼主| 发表于 2015-10-12 13:41 | 显示全部楼层
FGHUIOCXZVBMN 发表于 2015-10-12 12:06
刚打开电脑,看到有了回复,真高兴,真谢谢老师了

刚才代码运行过了,针对我提出的问题,确实解决得非常不错,不仅排列到位,而且还将姓名,性别,班级统统都分离了出来,我确实从未想到过,可以如此神奇的解决问题,很羡慕你。我从未学过这方面的知识,也不懂英文,但因工作的需要,迫使自己要去接触这门知识,加上年纪已不小,学起来不知有多难;虽然现已退休多年,但过去留下的许多问题还拿起看看,总想解决,留给单位后来人用用,这已成为我生活中的一件兴趣。这次第一次拿到网上求师,本不抱多大希望,不曾想到真有热心人,我真非常高兴,再次谢谢。你这段代码很神奇,我会好好学另加运用。
    还要求教的是,我提出的排床位问题,可用房间数和每个房间的床位数是每学期都会发生变化的,(一栋四层楼,每层二十个房间,男生女生各一栋,每间房间的床位数也不一样,床位号不表示床的多少,而表示具体位置),这次给你的仅是男生,但给你的“姓名”里含有性别和班级实际上是要删除的(对不起我没说清楚,让你多费时间)。另一个按学校要求,同一班的学生一般要求连排在一起(一般不会随机排,特殊情况下只是单个调动),在班级这个字段下原本是连续的班级数,(从姓名的数字里可以看到班级是连续的)但我为了检查是否漏排和同班级是否连续故改成了自然数,所以让你产生了误解,请谅。你肯定很忙,待你空些时候,再帮忙改改,谢了!

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 19:09 , Processed in 0.369644 second(s), 21 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表