Excel技术 | 名称10：名称在VBA代码中的应用示例—公式

 

本文的示例改编自Bill Jelen的经典VBA图书《VBA and Macros Microsoft Excel》系列中的内容。原示例为每日将一个包含各零售店销售数据的文件导入Excel工作簿，文件中包含商店的编号但没有商店的名称，使用VBA代码将导入的数据与工作簿中现有的商店编号和商店名称的表对比，如果存在编号，则在数据中添加该编号对应的商店名称，如果不存在编号，则在商店编号和名称表中添加编号并要求输入商店名称。

 

本文介绍的示例稍作简化，略去了导入外部数据的操作，假设数据已经存在于工作表中（如图1所示），或者用户经常手动添加数据，然后运用代码查找与编号对应的商店名（如图2所示）。

图1

 

如图2所示，为商店编号和对应的商店名称数据，我们将单元格区域A1:B6命名为“StoreList”。

图2

孩子你慢慢来：龙应台

作者：龙应台

当当 广告

购买

代码如下：

SubInsertData()

    Dim wksData As Worksheet

    Dim wksInfo As Worksheet

    Dim wb As Workbook

    Dim lngLastData As Long

    Dim lngLastTemp As Long

    Dim lngLastStore As Long

    Dim i As Long

    Dim strStore As String

 

    Set wb = ThisWorkbook

 

    '在工作表Data中存储着数据

    Set wksData =ThisWorkbook.Worksheets('Data')

 

    '在工作表Store中存储着编号列称表

    Set wksInfo =ThisWorkbook.Worksheets('Store')

 

    '将工作表Data变为当前工作表并在列N中放置列A的唯一值

    wksData.Activate

    lngLastData = Cells(Rows.Count,1).End(xlUp).Row

   Range('A1').Resize(lngLastData, 1).AdvancedFilter _

                        Action:=xlFilterCopy, _

                       CopyToRange:=Range('N1'), _

                        Unique:=True

 

    '对于唯一值,查看是否在当前的商店列表中

    lngLastTemp = Range('N' &Rows.Count).End(xlUp).Row

    Range('O1').Value = '不存在?'

    Range('O2:O' &lngLastTemp).FormulaR1C1 = _

       '=ISNA(VLOOKUP(RC[-1],StoreList,1,False))'

 

    '如果没有找到编号对应的商店,那么添加新商店

    lngLastStore = wksInfo.Range('A'& Rows.Count).End(xlUp).Row 1

    For i = 2 To lngLastTemp

        If Cells(i, 15).Value = True Then

            strStore = Cells(i, 14).Value

            wksInfo.Cells(lngLastStore,1).Value = strStore

            wksInfo.Cells(lngLastStore,2).Value = _

                InputBox(Prompt:='请为编号为' & strStore & _

                '的商店输入名称', Title:='找到新商店')

            lngLastStore = lngLastStore 1

        End If

    Next i

 

    '删除临时存放商店编号的区域

    Range('N1:O' &lngLastTemp).Clear

 

    '重新定义名称StoreList以适应新添加的商店

    lngLastStore = wksInfo.Range('A'& Rows.Count).End(xlUp).Row

    wksInfo.Range('A1:B' &lngLastStore).Name = 'StoreList'

 

    '使用VLookUP函数查找并在工作表Data的列B添加商店名

   wksData.Range('B1').EntireColumn.Insert

    Range('B1:B' &lngLastData).FormulaR1C1 = _

        '=VLOOKUP(RC1,StoreList,2,False)'

    '将公式转换成值

    Range('B1:B' &lngLastData).Value = Range('B1:B' & lngLastData).Value

 

    '释放内存空间

    Set wksData = Nothing

    Set wksInfo = Nothing

    Set wb = Nothing

EndSub

 

运行代码后，将在工作表Data中的商店编号列右侧插入一列并输入对应的商店名称，如图3所示。

图3

 

如果用户在工作表Data中输入了新数据，但新的编号不在已有的商店编号列表中，那么Excel会弹出输入框，要求用户为新编号输入商店名，如图4所示。

图4

 

输入完后，单击“确定”，会自动更新商店列表且在工作表Data中添加商店列。

 

欢迎分享本文，转载请注明出处。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。