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

2023-09-15 12:12| 来源: 网络整理| 查看: 265

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

【本文地址】

公司简介

联系我们