本文的示例改编自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中添加商店列。
欢迎分享本文,转载请注明出处。
欢迎在下面留言,完善本文内容,让更多的人学到更完美的知识。
联系客服