Question

我试图通过根据两张纸中的列（project name）扩展第一张纸的行数来统一两张不同纸张中的信息。

假设我的数据采用以下形式。

Sheet1 ：在project name列中，我有许多非重复的项目名称。我还有一个info列，其中包含项目特定信息。最后一列research question为空。
Sheet2 ：我再次有一个名为project name的列，但现在每个项目名称可以重复多次根据研究表征它的问题（research question列）。

这里有一个我的数据样本：

Sheet 1中：

    project name     info    research question
-------------------------------------------------
      name_1        bla_1          
      name_2        bla_2          
      name_3        bla_3

Sheet 2中：

    project name     research question
------------------------------------
        name_1        rq_1a
        name_1        rq_1b
        name_1        rq_1c
        name_2        rq_2a
        name_3        rq_3a
        name_3        rq_3b

我想要做的是通过适当地扩展 sheet1 行并附加 sheet2 行来统一两张表中的信息，即：

结果表：

    project name    info    research question
--------------------------------------------
       name_1      bla_1          
       name_1                  rq_1a
       name_1                  rq_1b
       name_1                  rq_1c
       name_2      bla_2          
       name_2                  rq_2a
       name_3      bla_3          
       name_3                  rq_3a
       name_3                  rq_3b

事实上，我有数百个项目和研究问题......你将如何实现这样的目标？

非常感谢，

斯特凡诺

Answer 1

如果您可以接受 CLOSE 但不完全符合您的预期结果，您可以做类似的事情（这基本上是Alex Weinstein的回答）

在工作表2上插入项目名称和研究问题之间的列，并标记为信息：

enter image description here

然后添加以下公式：

=IF(COUNTIF($A$1:$A3,A4)>0,"",VLOOKUP(A4,Sheet1!$A$3:$B$10,2))

这将导致以下结果：

enter image description here

现在如果您需要Exact输出，可以使用以下Sub：

Sub Sample()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim rngProjectName As Range
Dim rngSh1ProjectNames As Range
Dim lngInsertRow As Long

Set Sh1 = Sheets("Sheet1")
Set Sh2 = Sheets("Sheet2")

Set rngSh1ProjectNames = Sh1.Range("A4", Sh1.Range("A" & Sh1.Rows.Count).End(xlUp))

For Each rngProjectName In rngSh1ProjectNames
    On Error Resume Next
    lngInsertRow = WorksheetFunction.Match(rngProjectName.Value, Sh2.Range("A1", Sh2.Range("A" & Sh2.Rows.Count).End(xlUp)), 0)
    rngProjectName.EntireRow.Copy

    If Err.Number = 1004 Then
        Sh2.Rows(Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row + 1).Insert Shift:=xlDown
    Else
        Sh2.Rows(lngInsertRow).Insert Shift:=xlDown
    End If
Next rngProjectName
End Sub

作为注释我添加了一个错误，当工作表1上的项目名称不存在于工作表2上时，它将其添加到最后，如果您不会在Sheet1上有一个不在Sheet2上的项目名称，那么您可以替换：

On Error Resume Next
    lngInsertRow = WorksheetFunction.Match(rngProjectName.Value, Sh2.Range("A1",Sh2.Range("A" & Sh2.Rows.Count).End(xlUp)), 0)
    rngProjectName.EntireRow.Copy

    If Err.Number = 1004 Then
        Sh2.Rows(Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row + 1).Insert Shift:=xlDown
    Else
        Sh2.Rows(lngInsertRow).Insert Shift:=xlDown
    End If

简单地说：

        lngInsertRow = WorksheetFunction.Match(rngProjectName.Value, Sh2.Range("A1",Sh2.Range("A" & Sh2.Rows.Count).End(xlUp)), 0)
        rngProjectName.EntireRow.Copy
        Sh2.Rows(lngInsertRow).Insert Shift:=xlDown

或者，如果你想要不同的行为，那么你可以做你想做的事。

Answer 2

您不需要VBA。你只需要VLOOKUP功能。该函数将允许您从第二个表中获取与当前行名称匹配的值。

VLOOKUP简介：https://www.google.com/search?q=vlookup+intro&oq=vlookup+intro&sourceid=chrome&espv=210&es_sm=122&ie=UTF-8

根据公共列扩展工作表行并附加另一个工作表的信息

2 个答案: