VBA代码：一对多、多对多、多对一查询返回

VBA代码：1v1

'从a中找出c然后返回对应行中b的值 1对1

Function abc(a As Range, b As Range, c As String)
Dim t As String
'如果a与b的区域大小不同，就显示“错误”
If a.Rows.Count <> b.Rows.Count Then abc = "错误": Exit Function
'在区域a是循环
For i = 1 To a.Rows.Count
'如果在a中找到与c相同的值，就把同一行中的b的内容提取出来，存入变量t中。
If a.Cells(i, 1) = c Then t = t & Chr(10) & b.Cells(i, 1)
Next
'将变量的值赋给自定义函数
abc = t
End Function

'从A中选出 c中所包含的A列的某些单元格 对应的b列只要，a中包含c的子单元格关键词即可 1对多查找

Function AFinCBreakBIfAIncludeC(a As Range, b As Range, c As String)
Dim t As String
'如果a与b的区域大小不同，就显示“错误”
If a.Rows.Count <> b.Rows.Count Then abc = "错误": Exit Function
'在区域a是循环
If c <> "" Then
    For i = 1 To a.Rows.Count
    '如果在a中找到与c相同的值，就把同一行中的b的内容提取出来，存入变量t中。
        If a.Cells(i, 1) = c Then t = t & Chr(10) & b.Cells(i, 1)
        If a.Cells(i, 1) <> c Then
            If InStr(1, a.Cells(i, 1).Value, c) Then t = t & Chr(10) & b.Cells(i, 1)
        End If
    Next
End If
'将变量的值赋给自定义函数
AFinCBreakBIfAIncludeC = t
End Function

'从A中选出 c中所包含的A列的某些单元格 对应的b列只要，c中包含A的子单元格关键词即可。c为空则输出空。 多对1查找

Function AFinCBreakBIfCIncludeA(a As Range, b As Range, c As String)
Dim t As String
'如果a与b的区域大小不同，就显示“错误”
If a.Rows.Count <> b.Rows.Count Then abc = "错误": Exit Function
'在区域a是循环
If c <> "" Then
    For i = 1 To a.Rows.Count
        '如果在a中找到与c相同的值，就把同一行中的b的内容提取出来，存入变量t中。
        If a.Cells(i, 1) = c Then t = t & Chr(10) & b.Cells(i, 1)
        If a.Cells(i, 1) <> c Then
            If InStr(1, c, a.Cells(i, 1).Value) Then t = t & Chr(10) & b.Cells(i, 1)
        End If
    Next
End If
'将变量的值赋给自定义函数
AFinCBreakBIfCIncludeA = t
End Function

'HSI转换使用 搜索条件是表二的需求，返回表二引脚对应的需求对应的function

Sub Mycode()

Dim Sheet1Long As Integer '此字符设置需要搜寻表1的行数，主要用于确定对比引脚号
Dim webLong As Integer      '此字符设置需要搜寻表2的行数，主要用于需要填充的引脚号做搜寻
Dim func As Byte '0-255,设置表一功能数
Dim func2 As Byte '0-255,设置表二需求功能数

'需要配置的参数：
Dim Sheet1Long_Limit As Integer                                 '此字符设置需要搜寻表1的行数，主要用于确定对比引脚号
Sheet1Long_Limit = 7  '限制表一的引脚数量
Dim webLong_Limit As Integer                                    '此字符设置需要搜寻表2的行数，主要用于需要填充的引脚号做搜寻
webLong_Limit = 7    '限制表二的引脚数量  应该必须和表一一致
Dim func_Limit As Byte                                          '0-255,设置表一功能数
func_Limit = 7    '限制表一的功能功能
Dim func2_Limit As Byte                                         '0-255,设置表二需求功能数
func2_Limit = 7    '限制表二的分类数量

Dim S1_Star_location As Byte
S1_Star_location = 0    '设置表一功能的起始位置，注意完整起始位置是  S2_Star_location + func2 * Sheet2Step_Size  ，乘以了一个步进长度，所以最小为 步进长度
Dim S2_Star_location As Byte
S2_Star_location = 0    '设置表二功能的起始位置，注意完整起始位置是  S2_Star_location + func2 * Sheet2Step_Size  ，乘以了一个步进长度，所以最小为 步进长度

Dim Sheet1Step_Size As Byte
Sheet1Step_Size = 2    '限制表一功能的步进长度
Dim Sheet2Step_Size As Byte
Sheet2Step_Size = 2    '限制表二分类的步进长度

Dim S1_Star As Byte
S1_Star = 2    '设置表一的开始行
Dim S2_Star As Byte
S2_Star = 2    '设置表二的开始行

Dim S1 As String
S1 = "Sht1"  '设置表一名称
Dim S2 As String
S2 = "wed"    '设置表二名称
'需要配置的参数结束


For webLong = S2_Star To webLong_Limit         '设置表二搜寻引脚数量
    'If Worksheets("Sheet1").Cells(webLong, 1).Value <> "" Then Exit For  '如果表二出现空格则退出此次循环
    For Sheet1Long = S1_Star To Sheet1Long_Limit        '设置对表1的排查数量，必须确保表一表二对比数量相同
        'If Worksheets("wed").Cells(Sheet1Long, 1).Value <> "" Then Exit For      '如果对比到空白单元格退出当前循环
        If Worksheets(S2).Cells(webLong, 1).Value = Worksheets(S1).Cells(Sheet1Long, 1).Value Then    '判断表二首列引脚所在表一的行
            For func2 = 1 To func2_Limit     '对7条需求功能排查
                Worksheets(S2).Cells(webLong, func2 * 2).Value = ""  '把需要填写的格子清楚掉，其他单元格不影响
                For func = 1 To func_Limit    '对7条需求功能排查
                    If Worksheets(S2).Cells(1, S2_Star_location + func2 * Sheet2Step_Size).Value <> "" Then   '表二的条件不为空
                        If InStr(1, Worksheets(S1).Cells(Sheet1Long, S1_Star_location + func * Sheet1Step_Size).Value, Worksheets(S2).Cells(1, S2_Star_location + func2 * Sheet2Step_Size).Value) Then '判断表二的首行判断字符是否被包含在表一的function中
                            Worksheets(S2).Cells(webLong, S2_Star_location + func2 * Sheet2Step_Size).Value = Worksheets(S2).Cells(webLong, S2_Star_location + func2 * Sheet2Step_Size).Value & Chr(10) & Worksheets(S1).Cells(Sheet1Long, S1_Star_location + func * Sheet1Step_Size).Value '满足条件赋值
                        End If
                    End If
                Next
            Next
        End If
    Next
Next
End Sub