我有第1页,其中A列填充了maintasks,B列填充了查找值。
工作表2具有查找值的范围。工作表1中的B列与工作表2中的A列相同。
在表3中,我需要maintask 在表1(A列)中,应根据sheet2(B列)中的子任务和表2中的预算时间(C列)填充。
请检查以下输出。
输出
解决方案应查找sheet1中的B列并返回到表2并计算子任务数(B列)并填写表1(A列)中的主要任务多次,包括子任务中的内容和预算时间。
我尝试过使用部分查找和其他格式但是卡住了。
答案 0 :(得分:0)
您要做的是在第二张表格中的左侧外部加入到第一张表格中。
所以低于带有 PowerQuery 的选项1和带有 VBA-SQL 的<2>
选项1:
您可以使用免费加载项PowerQuery(内置于2016年)执行此操作。
1)在表1和表2中将数据设置为表格(单击数据范围内的填充单元格,然后按 Alt + T &gt;选择我的表有标题。
2)突出显示每个表格,然后转到data
标签(2016)或Powerquery
标签(2010-2013),并从表格中创建新的查询数据(Get and Transform
)
这将弹出一个查询编辑器窗口,显示您的表格(您可以在右侧重命名的查询/表格)
3)然后,您可以选择关闭和load to > only create connection
(从窗口的左上角
仅选择连接
对表1和表2中的表重复。
4)然后创建新查询&gt;合并查询&gt;合并
确保您的子任务表是第一个选择的表,主要任务是第二个。单击两个表中的Content_Category_Product Sub Type
列,使其突出显示(这将是连接列)
检查join kind
是否为Left outer
,并且选择匹配时有绿色勾号。
然后单击“确定”并加载到sheet3。
5)在第一列升序
上对结果表进行排序6)查看结果:
您可以查看有关Powerquery
的大量资源。这将允许您更改列名等。您还可以删除不需要的列以匹配您发布的图像。
或选项2:
使用SQL,调整barrowc的方法和Johan Kreszner的函数,确保转到VBA编辑器(Alt-F11)并添加引用(Tools > References
)到“Microsoft ActiveX Data Objects X.X Library
”。
我假设只有表格在表1和表2中,否则您可能需要更改SQL以定位表格的范围(列表对象),这就是为什么我已经包含Johan的函数来返回列表的范围对象,只要您将表名称作为字符串传递。
Option Explicit
Sub LeftJoinTables()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;IMEX=1;HDR=YES"";"
.Open
End With
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT [Main Task], [Sub Task], [Budget Hours] FROM [Sheet2$] LEFT JOIN [Sheet1$] ON [Sheet2$].[Content Category_Product Sub type] = " & _
"[Sheet1$].[Content Category_Product Sub type] ORDER BY [Main Task]", cn
Dim fld As ADODB.Field
Dim i As Integer
With ThisWorkbook.Worksheets("Sheet3")
.UsedRange.ClearContents
i = 0
For Each fld In rs.Fields
i = i + 1
.Cells(1, i).Value = fld.Name
Next fld
.Cells(2, 1).CopyFromRecordset rs
.UsedRange.Columns.AutoFit
End With
rs.Close
cn.Close
End Sub
Public Function GetRange(ByVal sListName As String) As String
Dim oListObject As ListObject
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Sheets
For Each oListObject In ws.ListObjects
If oListObject.Name = sListName Then
GetRange = "[" & ws.Name & "$" & Replace(oListObject.Range.Address, "$", "") & "]"
Exit Function
End If
Next oListObject
Next ws
End Function