怎样用VBA把座次表的姓名转为座签姓名？

xinxin2021 · 发表于 2024-12-3 23:02

举办会议，经常需要把座次表中的姓名打印成座签，贴到会议室的坐位上。怎样用用VBA把座次表中的姓名快速转为座签？
座次表为excel文件，座签为WORD文件（也只可以是excel文件）。
如下附件。

test.zip (11.33 KB, 下载次数: 12)

taller · 发表于 2024-12-4 01:51

转换的规则是什么？每行几个姓名

另外，为什么一定要转换到Word中，在Excel中调整字体字体和单元格尺寸，直接打印会更方便吧

xinxin2021 · 发表于 2024-12-4 06:53

本帖最后由 xinxin2021 于 2024-12-4 07:17 编辑

taller 发表于 2024-12-4 01:51
转换的规则是什么？每行几个姓名

另外，为什么一定要转换到Word中，在Excel中调整字体字体和单元格尺寸 ...

座次表是一排7人（也就是一行7人），几排不限。转换规则如下：

1.转换的结果一行可以是三个姓名，姓名多了不方便打印，因为姓名的字体比较大。字体型号宋体，大小要醒目。

2.转换结果第一页是座次表的第一列到第三列的前三行，第二页是座次表第四列到第六列的前三行，第三页是座次表第七列的前三行。

第四页是座次表第一列到第三列的第四行到第六行，第五页是第四列到第六列的第四行到第六行，第六页是第七列的第四行到第六行。

以此类推。

3.转换结果可以是excel。只要能转换，转换结果是什么文件不限。

taller · 发表于 2024-12-4 07:55

taller · 发表于 2024-12-4 07:57

请自行调整模板Sheet2工作表中单元格尺寸使得可以填充满一页

座次表.7z (20.61 KB, 下载次数: 36)

xinxin2021 · 发表于 2024-12-4 18:25

本帖最后由 xinxin2021 于 2024-12-4 18:30 编辑

taller 发表于 2024-12-4 07:57
请自行调整模板Sheet2工作表中单元格尺寸使得可以填充满一

你的解决方案已经很好了，感谢您！不过，我想把规则再优化一下，让程序使用起来更方便。优化的规则如下：

座次表是一排N个人（也就是一行有N个姓名），几排不限。转换规则如下：

1.转换的结果一行有三个姓名（姓名多了不方便打印，因为姓名的字体比较大。字体型号宋体，大小要醒目）。

2.转换结果首先（前一页或前几页）是座次表的第一列到第三列的所有姓名，其次（中间一页或中间几页）是座次表第四列到第六列的所有姓名，
再次（最后一页或最后几页）是座次表第七列到第九列的所有姓名。
以此类推。

3.要考虑座次表姓名列数是“3+1”或“3的倍数+1”的情况。比如，座次表有4列，或有7列，或有10列，或有13列，有16列……。

如果座次表只有4列，那么转换结果首先（前一页或前几页）是座次表的第一列到第三列的所有姓名，其次（中间一页或中间几页）是座次表第四列的所有姓名。
如果座次表只有7列，那么转换结果首先（前一页或前几页）是座次表的第一列到第三列的所有姓名，其次（中间一页或中间几页）是座次表第四列到第六的所有姓名，再次（最后一页或最后几页）是座次表第七列的所有姓名。
如果座次表有10列，那么转换结果首先（前一页或前几页）是座次表的第一列到第三列的所有姓名，其次是座次表第四列到第六的所有姓名，再次是座次表第七列到第九的所有姓名，最后是是座次表第10列的所有姓名。
以此类推。
4.转换结果是excel格式。

熊文来 · 发表于 2024-12-4 21:34

抢占一个沙发。顶一下。

xinxin2021 · 发表于 2024-12-20 21:21

taller 发表于 2024-12-4 07:55

这个代码相当好！不过，想再修改一下，让程序更实用，好上加好，你看这样可以吗？一是每个桌签加上一个编号，从1开始，可以加在姓名右侧，如附件的样式。二是桌签按编号排列，打到A4纸上，每张纸10个桌签（姓名）。样式如附件。

桌签.rar (12.32 KB, 下载次数: 5)

chxw68 · 发表于 2024-12-21 09:13

Sub test()
Dim r%, i%
Dim arr, brr
With Worksheets("座次表")
r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
arr = .Range("a3").Resize(r - 2, c)
End With
With Worksheets("桌签")
.Cells.ClearContents
m = 1
n = 1
s = 0
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
If Len(arr(i, j)) <> 0 Then
s = s + 1
.Cells(m, n) = arr(i, j)
.Cells(m, n + 1) = s
n = n + 4
If n > 5 Then
n = 1
m = m + 3
End If
If s Mod 10 = 0 Or (i = UBound(arr) And j = UBound(arr, 2)) Then
.PrintOut
.Cells.ClearContents
m = 1
n = 1
End If
End If
Next
Next
End With
End Sub

复制代码

chxw68 · 发表于 2024-12-21 09:14

参与一下。

		自动登录	找回密码
密码			免费注册

[求助] 怎样用VBA把座次表的姓名转为座签姓名？

评分

怎样用vba设计一个程序，

评分