考场座次表如何实现W排列

蘫铱朲

考场座次表如何实现W排列，也就是第一列1-8，第二列从后往前9-16。。。如下所示：
1   16   17    32
2   15   18    31
3   14    19   30
4   13    20   29
5   12    21   28
6   11    22   27
7   10    23   26
8    9     24    25
请大神帮忙，万分感谢！
如何生成带照片的座次表1.rar (259.42 KB, 下载次数: 43)

2018-6-14 07:20 上传

点击文件名下载附件

蘫铱朲

请大神帮忙修改下，谢谢

蘫铱朲

有大神在吗？

蘫铱朲

有人帮个忙吗？

蘫铱朲

没人帮忙吗？

chxw68

楼主的代码实现的就是按W型排列，不知道楼主还要什么？

ahnyt

看看是不是这个意思，符合就加分

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("成品")
   
7.     sch = .Range("f1")
   
8.   End With
   
9.   With Worksheets("数据库")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     arr = .Range("a2:k" & r)
    
12.   End With
    
13.   ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
14.   m = 0
    
15.   For i = 1 To UBound(arr)
    
16.     If arr(i, 4) = sch Then
    
17.       m = m + 1
    
18.       For j = 1 To UBound(arr, 2)
    
19.         brr(m, j) = arr(i, j)
    
20.       Next
    
21.     End If
    
22.   Next
    
23.   If m = 0 Then
    
24.     MsgBox "没有该试场数据！"
    
25.     Exit Sub
    
26.   End If
    
27.   With Worksheets("成品")
    
28.     .Range("i1") = arr(1, 5)
    
29.     .Range("l1") = m
    
30.     For Each aa In .Shapes
    
31.       If aa.Type = 11 Then
    
32.         aa.Delete
    
33.       End If
    
34.     Next
    
35.     .Range("c3:c41,f3:f41,i3:i41,l3:l41").ClearContents
    
36.     x = 3
    
37.     y = 1
    
38.     For i = 1 To m
    
39.       .Cells(x, y + 2) = brr(i, 6)
    
40.       .Cells(x + 1, y + 2) = brr(i, 3)
    
41.       .Cells(x + 2, y + 2) = brr(i, 8)
    
42.       .Cells(x + 3, y + 2) = brr(i, 7)
    
43.       FilPath = ThisWorkbook.Path & "\照片" & brr(i, 2) & ".jpg"
    
44.       If Dir(FilPath) <> "" Then
    
45.         .Pictures.Insert(FilPath).Select
    
46.         Set rng = .Cells(x, y).Resize(4, 1)
    
47.         With Selection
    
48.           .ShapeRange.LockAspectRatio = msoFalse
    
49.           .Top = rng.Top + 1
    
50.           .Left = rng.Left + 1
    
51.           .Width = rng.Width - 1
    
52.           .Height = rng.Height - 1
    
53.         End With
    
54.       Else
    
55.         .Cells(x, y) = "没有照片"
    
56.       End If
    
57.       If y Mod 2 = 1 Then
    
58.         x = x + 5
    
59.         If x > 38 Then
    
60.           x = 38
    
61.           y = y + 3
    
62.         End If
    
63.       Else
    
64.         x = x - 5
    
65.         If x < 3 Then
    
66.           x = 3
    
67.           y = y + 3
    
68.         End If
    
69.       End If
    
70.     Next
    
71.   End With
    
72. End Sub
    

复制代码

chxw68

前面没有看懂楼主意思。

zopey

       k = 1: i = 3: j = 1: f = 1


       k = k + 1
       If k = 9 Or k = 25 Then
          j = j + 3: f = -1
       ElseIf k = 17 Then
          j = j + 3: f = 1
       Else
          If k = 2 Then [i1].Value = rst2("试场位置")
          i = i + 5 * f
       End If



座次表2.zip (125.24 KB, 下载次数: 40)

2018-6-14 09:59 上传

点击文件名下载附件