[求助]关于邮件合并的问题

bigpandar

我现在有一个EXCEL数据表，另有一个WORD的表格，请问我应该怎么做才能实现如附件中WORD文件的效果,谢谢 0nI2dW9t.rar (11.04 KB, 下载次数: 11)

2007-1-23 19:35 上传

点击文件名下载附件
[求助]关于邮件合并的问题

c81

以下作为参考：

1.在Excel中，专业人数处理成20的倍数，不足的用空行来代替。可向Excel组咨询相关VBA。其实我相信你的学校专业数量不多，最多十来个吧，在data.xls中做成20的倍数，插空行不是什么难事吧？

2.以页码数作为考场序数

3.每考场的“专业”名称正常邮件合并，考场学生姓名域除每页除第一个外，用«Next Record»«xm».......

[此贴子已经被作者于2007-1-23 20:42:16编辑过]

bigpandar

专业确实只有十来个，但是既然自动化了，就自动化到底吧，这个VBA代码我得去EXCEL版再问问，多谢楼上

[此贴子已经被作者于2007-1-23 21:12:03编辑过]

bigpandar

要是哪位大虾知道这个VBA的写法，方便的话也请贴上来，万分感谢

sylun

勉强做了出来，看看是否可行。注：数据源为“合并源”工作表，因对excel的公式与函数不很了解，加了不少辅助列。不会用vba。

e8rsqd7s.rar (36.44 KB, 下载次数: 9)

2007-1-24 19:26 上传

点击文件名下载附件
[求助]关于邮件合并的问题

[此贴子已经被作者于2007-1-24 19:27:40编辑过]

bigpandar

效果是达到了,不过实现的过程我还是得好好研究一下,先谢谢楼上

如果哪位朋友有更VBA实现插空行的方法,也非常欢迎您能贴上来,谢谢

konggs

Excel的VBA吗？

konggs

Excel的VBA如下：

Option Explicit

Sub 插入空行()
    Dim arr '数组
    Dim bend As Long
    bend = Range("b:b").Rows.Count '取b列的总行数
    bend = Range("b" & bend).End(xlUp).Row '取b列有数的最后一行
    arr = Range("a2:b" & bend) '数组赋值
    Dim j As Long, nextA As String
    Dim i As Long, k As Long
    Dim no As Long, e As Long
    ReDim newarr(1 To UBound(arr) * 20, 1 To 2)
    i = 1: k = 0
   
    nextA = Range("b2")
    For j = 1 To UBound(arr)
        If arr(j, 2) = nextA Then
           k = k + 1
        Else
            no = k Mod 20
            If no <> 0 Then
                For e = 1 To 20 - no
                    newarr(i, 2) = ""
                    newarr(i, 1) = ""
                    i = i + 1
                Next
                k = 1
            Else
                k = 0
            End If
        End If
           newarr(i, 1) = arr(j, 1)
           newarr(i, 2) = arr(j, 2)
        i = i + 1
        nextA = arr(j, 2)
    Next
    Range("c2:d" & UBound(newarr)) = newarr
    '为方便放到C列。你可以放在原来的A2的位置，即：
    'Range("a2:b" & UBound(newarr)) = newarr
End Sub