-1

我试图通过根据两个工作表中存在的列（project name）扩展第一个工作表的行数来统一两个不同工作表中的信息。

假设我的数据格式如下。

  • Sheet1：在列中，project name我有许多不重复的项目名称。我还有一个info包含项目特定信息的专栏。最后一列research question, 是空的。

  • Sheet2：我又有一列叫做project name，但是现在每个项目名称可以根据其特征的研究问题的数量重复多次research question（列）。

这里有我的数据样本：

表1：

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

表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

事实是我有数百个项目和数以千计的研究问题..您将如何实施这样的事情？

非常感谢，

斯特凡诺

4

2 回答 2

2

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

在工作表 2 上，在项目名称和研究问题之间插入一列，并在信息中添加标签：

在此处输入图像描述

然后添加以下公式：

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

这将导致以下结果：

在此处输入图像描述

现在，如果您需要确切的输出，可以使用以下子：

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 上不存在时，它会将其添加到末尾，如果工作表 1 上的项目名称永远不会在工作表 2 上，那么你可以替换：

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

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

于 2013-11-11T14:52:27.557 回答
-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

于 2013-11-11T14:17:46.140 回答