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

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

这段时间遇到了一件事，就是我须要给不少小伙伴打钱，可是每次打给的人又不同。每次都一遍遍地作一些重复工做，天然不是个人风格，因此我写了下面这个VBA脚本执行个人工做：

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

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

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

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

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

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