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

金樽空对月

grf1973 发表于 2015-10-12 09:48
针对楼上代码小改了一下，加上了随机排的功能。

大开眼界，学习了，我下载下来搞了俩小时都没想出个好的思路，真是晕呀。我只想着单元格循环可以3步一循环，就是没想到数组也是可以3步一循环。{:35:}

金樽空对月

FGHUIOCXZVBMN 发表于 2015-10-12 13:41
刚才代码运行过了，针对我提出的问题，确实解决得非常不错，不仅排列到位，而且还将姓名，性别，班级统统 ...

代码改成这样就不是随机安排了：

1. Sub 排位()
   
2. Dim X, Y, M, N, i, STR, ARR, ARR1
   
3. M = Sheets("设置").Range("AD65536").End(xlUp).Row
   
4. N = Sheets("设置").Range("B65536").End(xlUp).Row
   
5. ARR = Sheets("设置").Range("C2:L" & N)
   
6. ARR1 = Sheets("设置").Range("AE2:AE" & M)
   
7. For X = 1 To UBound(ARR) Step 3
   
8.    For Y = 1 To 10
   
9.      If ARR(X, Y) <> "" Then
   
10.        k = k + 1
    
11.        STR = ARR1(k, 1)
    
12.        i = InStr(STR, "男")
    
13.        ARR(X + 1, Y) = Left(STR, i - 1)
    
14.        ARR(X + 2, Y) = Mid(STR, i + 1)
    
15.      End If
    
16.    Next Y
    
17. Next X
    
18. Sheets("设置").Range("C2").Resize(UBound(ARR), 10) = ARR
    
19. End Sub
    

复制代码

金樽空对月

FGHUIOCXZVBMN 发表于 2015-10-12 13:41
刚才代码运行过了，针对我提出的问题，确实解决得非常不错，不仅排列到位，而且还将姓名，性别，班级统统 ...

那姓名对应的班级在哪一列呢？

FGHUIOCXZVBMN

FGHUIOCXZVBMN 发表于 2015-10-12 13:41
刚才代码运行过了，针对我提出的问题，确实解决得非常不错，不仅排列到位，而且还将姓名，性别，班级统统 ...

FGHUIOCXZVBMN 发表于 2015-10-12 12:06
刚打开电脑，看到有了回复，真高兴，真谢谢老师了

刚才代码运行过了，针对我提出的问题，确实解决得非常不错，不仅排列到位，而且还将姓名，性别，班级统统都分离了出来，我确实从未想到过，可以如此神奇的解决问题，很羡慕你。我从未学过这方面的知识，也不懂英文，但因工作的需要，迫使自己要去接触这门知识，加上年纪已不小，学起来不知有多难；虽然现已退休多年，但过去留下的许多问题还拿起看看，总想解决，留给单位后来人用用，这已成为我生活中的一件兴趣。这次第一次拿到网上求师，本不抱多大希望，不曾想到真有热心人，我真非常高兴，再次谢谢。你这段代码很神奇，我会好好学另加运用。

    还要求教的是，我提出的排床位问题，可用房间数和每个房间的床位数是每学期都会发生变化的，（一栋四层楼，每层二十个房间，男生女生各一栋，每间房间的床位数也不一样，床位号不表示床的多少，而表示具体位置），这次给你的仅是男生，但给你的“姓名”里含有性别和班级实际上是要删除的（对不起我没说清楚，让你多费时间）。另一个按学校要求，同一班的学生一般要求连排在一起（一般不会随机排，特殊情况下只是单个调动），在班级这个字段下原本是连续的班级数，（从姓名的数字里可以看到班级是连续的）但我为了检查是否漏排和同班级是否连续故改成了自然数，所以让你产生了误解，请谅。你肯定很忙，待你空些时候，再帮忙改改，谢了！

grf1973

1. Sub test()
   
2.     Dim org, arr, brr
   
3.     Dim i&, j&, k&
   
4.     With Sheets("sheet1")
   
5.         org = .Range("ad1").CurrentRegion.Value   '原序名单
   
6.         .Range("af2:af" & UBound(org)).Formula = "=rand()+rc[-2]"  '辅助列（随机数+班级名）
   
7.         .Range("ad2:af" & UBound(org)).Sort key1:=.[af2]   '按辅助列排序（在本班内随机排）
   
8.         .[af:af].ClearContents      '清除辅助列
   
9.         arr = .Range("ad1").CurrentRegion.Value      '乱序名单
   
10.         .Range("ad1").CurrentRegion.Value = org       '恢复原序
    
11.         
    
12.         lRow = .Range("b" & Rows.Count).End(3).Row
    
13.         brr = .Range("c2:l" & lRow).Value
    
14.         k = 1
    
15.         For i = 1 To UBound(brr) Step 3
    
16.             For j = 1 To 10
    
17.                 If brr(i, j) <> "" Then
    
18.                     k = k + 1
    
19.                     If k <= UBound(arr) Then
    
20.                         brr(i + 1, j) = arr(k, 2)
    
21.                         brr(i + 2, j) = arr(k, 1)
    
22.                     End If
    
23.                 End If
    
24.             Next
    
25.         Next
    
26.         .Range("c2").Resize(UBound(brr), 10) = brr
    
27.     End With
    
28. End Sub

复制代码

grf1973

按要求改了。依然可以随机排，不过只在班级内部随机排，排床号时仍然按班级次序排。

FGHUIOCXZVBMN

grf1973 发表于 2015-10-12 16:52
按要求改了。依然可以随机排，不过只在班级内部随机排，排床号时仍然按班级次序排。

完全达到了目的，谢谢你，不知已后遇到问题是否还能遇上你。