EXCEL 笔记 --不定时更新

EXCEL 笔记

用以记录实际工作中遇到的需求解决方案，主要是用作备份以便后期查询，不负责回答疑问
别问我公式什么意思，有的我也不知道，能用就行

2021-09-01

vlookup 数组

需求

如下图，A列是诊断，有合并书写的情况，需要将每个诊断单独匹配标准名称，并在B列给出每个诊断对应的ICD编码

方法一

首先想到的是VBA，自己写一个函数，调用即可。代码如下

Public Function VlookupArr(OriText As String, splitsymbol As String, table_array_arr As Range, col_index_num_arr As Integer, Optional range_lookup_arr As Boolean = 0)
'''
'
'OriText: 待匹配字符串
'splitsymbol: 待匹配字符串的分隔字符，可为多个
'其他变量同VLOOKUP函数变量
'''
Dim result(), vlookup_result As String
Dim rangename As Range
Dim symbol_arr() As String

'处理分隔符，统一替换为第一个分隔符
to_split_symbol = Left(splitsymbol, 1)
symbol_length = Len(splitsymbol)
ReDim symbol_arr(1 To symbol_length)

If symbol_length > 1 Then
    For i = 2 To symbol_length
        s = Mid(splitsymbol, i, 1)
        OriText = Replace(OriText, s, to_split_symbol) '各种分隔符统一替换为第一个分隔符，后面统一分割
    Next i
End If

'按 to_split_symbol将待匹配字符串处理成数组并调用内置vlookup函数匹配
vlookup_result = ""
Arr = Split(OriText, to_split_symbol)
end_arr = UBound(Arr)
ReDim result(0 To end_arr)

For i = 0 To end_arr
    result(i) = Application.IfError(Application.VLookup(Arr(i), table_array_arr, col_index_num_arr, range_lookup_arr), "#NA")
Next i

'将匹配后的数组输出单个字符串
For j = 0 To end_arr
    If j = 0 Then
        vlookup_result = result(j)
    Else
        vlookup_result = vlookup_result & to_split_symbol & result(j)
    End If
Next j

VlookupArr = vlookup_result

End Function

20210910更新，更正了传入vlookup函数的变量类型

然后直接在excel表格中调用VlookupArr即可。

方法二

网上搜了一下关于vlookup在数组中使用的文章，找到如下教程 http://excel880.com/blog/archives/11253 里面提到的公式如下：

=VLOOKUP(T(IF({1},I3:I7)),$C$3:$F$10,4,0)

其中，I3:I7是作为数组使用，因此，只需要将此处稍作修改即可。

将A列按,分割后作为数组，替换I3:i7即可，但excel内置函数中似乎没有相关函数，所以，还得借用VBA中的 split方法。

Public Function Split_arr(text As String, delimiter As String)
Split_arr = split(text, delimiter)
End Function

因VLOOKUP在使用数组后返回的仍然是数组，不符合结果在同一个单元格的要求，所以，用TEXTJOIN连接一下即可。

最终公式如下：

=TEXTJOIN(",",0,VLOOKUP(T(IF({1},Split_arr(C264,","))),[ICD国标版.xlsx]对照用!$D:$F,3,0))

2022-02-14

批量替换

说明：待补充

Public Function SubstituteArr(text As String, old_string_arr As Range, new_string As String)

For Each i In old_string_arr
    text = Replace(text, i, new_string)
Next i

SubstituteArr = text

End Function