Excel中的VBA宏：每次划款前从总名册中同步用户数据到当前页

我使用的Office为 Microsoft Office Professional Plus 2010，我使用的Excel 版本为14.0.4760.1000（32位）。

这段时间遇到了一件事，就是我需要给很多小伙伴打钱，但是每次打给的人又不一样。每次都一遍遍地做一些重复工作，自然不是我的风格，所以我写了下面这个VBA脚本执行我的工作：

1、建立一个Excel，第一个Sheet页取名为“成员名册”，里面一共有三列，第一列为成员名称，第二列为打款方式，第三列为账号

2、将一个新的Sheet页命名为报销单1，先填写前两列，第一列写上成员名称，第二列写上打款金额

3

3、添加宏GenerateDoc，在Excel自带的VisualBasic编辑器中输入下面代码

'从总名单中将对应信息填入新建的名单中
'约定各列内容：
' 1 - SheetNameList 成员名称-汇款方式-账号号码（需全部填写）
' 2 - SheetGenDoc 成员名称-汇款金额-汇款方式（通过本Sub同步）-账号号码（通过本Sub同步）-是否汇讫（默认未汇）
Sub GenerateDoc()

    Dim SheetNameList As Worksheet
    Set SheetNameList = Sheets("成员名册") '成员名册Sheet页名
    Dim SheetGenDoc As Worksheet
    Set SheetGenDoc = Sheets("报销单1") '待同步数据的报销单的Sheet页名，每次需要视情况填写！

    '从总名单中找出当前名单中的成员的对应信息
    Dim IsFound
    Dim i, j As Integer
    i = 1
    Do While SheetGenDoc.Cells(i, 1).Text <> ""
        'MsgBox SheetGenDoc.Cells(i, 1).Text
        IsFound = False
        j = 1
        Do While SheetNameList.Cells(j, 1).Text <> ""
            'MsgBox SheetNameList.Cells(j, 1).Text
            If SheetGenDoc.Cells(i, 1).Text = SheetNameList.Cells(j, 1).Text Then
                SheetGenDoc.Cells(i, 3).FormulaR1C1 = SheetNameList.Cells(j, 2).Text
                SheetGenDoc.Cells(i, 4).FormulaR1C1 = SheetNameList.Cells(j, 3).Text
                SheetGenDoc.Cells(i, 5).FormulaR1C1 = "-"
                IsFound = True
            End If
            j = j + 1
        Loop

        '如成员未在总名单中找到，标记为未找到
        If Not IsFound Then
            With SheetGenDoc.Cells(i, 3)
                .FormulaR1C1 = "未找到"
                '.Font.Color = -16776961 '文字加红
                '.Font.TintAndShade = 0  '文字加红
            End With
            With SheetGenDoc.Cells(i, 4)
                .FormulaR1C1 = "未找到"
                '.Font.Color = -16776961 '文字加红
                '.Font.TintAndShade = 0  '文字加红
            End With
            With SheetGenDoc.Cells(i, 5)
                .FormulaR1C1 = "-"
                '.Font.Color = -16776961 '文字加红
                '.Font.TintAndShade = 0  '文字加红
            End With
        End If
        i = i + 1
    Loop

    '设置最后一列（第四列）为下拉选择列，包括【-】和【汇讫】两个选项
    SheetGenDoc.Columns("E:E").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="-,汇讫"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With

    '设置各列宽度和颜色
    With SheetGenDoc
        .Columns("A:A").ColumnWidth = 10
        .Columns("B:B").ColumnWidth = 10
        .Columns("C:C").ColumnWidth = 20
        .Columns("D:D").ColumnWidth = 20
        .Columns("E:E").ColumnWidth = 20
        .Columns("E:E").Font.Color = -16776961
        .Columns("E:E").Font.TintAndShade = 0
    End With

End Sub

4、执行这个VBA宏后，C、D两列会自动同步打款方式和账号，E列会出现一个下拉选项，包括“-”（未打款）和“汇讫”（已打款）两种选项

使用这个宏，好处是每次收到新名单时，可以很快地根据成员名册的信息，把打款方式和账号同步到一张新的Sheet页，为操作提供了一些便利性。当然这个宏也可以在适当修改或扩展后用于其他一些类似的场合（比如发通知、发传真等），它最主要的作用是减轻一些由人进行的手工操作的工作量，并减少人在进行这些工作时可能发生的错误。

友情提示：和钱有关的事情都不是小事，虽然VBA可以让我们对Excel的处理变得傻瓜化，但在每次打款前还是要和收款人再次确认一下打款方式和账号。

来源：oschina

链接：https://my.oschina.net/u/1425762/blog/616946