根据单元格内容插入行并展开

Question

我几乎没有为 excel 编写过 vba 编码，但我熟悉用于访问的 vba 编码。非常感谢任何和所有的帮助！

此问题中使用的示例只是实际存在的数据量的一个片段，因此请记住，代码最多需要容纳 100 多行。

我需要展开并填写下表，tbl1：

使用下表中的数据，tbl2：

我希望输出看起来像这样，tbl3:

我试图将其分解为多个部分，首先我使用 countif 来确定@​​987654330@ 现在多次出现在tbl2 中，然后在相应行下插入该数量的行，但是我发现它实际上并没有插入行，而是将数据附加到现有行。我想插入行以希望列team 可以为特定的district 保持合并。我似乎无法“插入”行，就像您右键单击插入行时所做的那样。

我遇到的另一个问题是将tbl2 中的附加数据放入输出tbl3。我知道我不能使用 vlookup，因为每个值都有多个匹配项，我不知道如何继续。

编辑 tbl2 实际上将包含比 tbl1 所需的更多的数据，每一行都会有不同的值组合，例如：Cat, Red, South 但我们只对 tbl1 中的值感兴趣，以扩展和填充 tbl1。

Answer 1

让我们看一下 Powerquery 解决方案。我从两个表（Excel 中的列表对象和智能表）开始，我称之为 tblAnimals 和 tblSuburbs。

我将这些表导入 Power Query（转到数据和从表/范围）并将它们保存在 PowerQuery 中，仅作为连接。然后我加入了这两个查询（数据、组合查询），并将 Suburb 作为加入的列。

结果是

这是执行此操作的 M 代码

let
    Source = Table.NestedJoin(tblAnimals, {"Suburb"}, tblSuburbs, {"Suburb"}, "tblSuburbs", JoinKind.LeftOuter),
    combineSuburbs = Table.ExpandTableColumn(Source, "tblSuburbs", {"District", "Team"}, {"District", "Team"}),
    reorderColumns = Table.ReorderColumns(combineSuburbs,{"Suburb", "Animal", "Colour", "District", "Team"})
in
    reorderColumns

Answer 2

如果我对您的理解正确，那么您不需要 VBA。

逻辑

1. 在tbl2 的第四列中使用VLOOKUP 并从tbl1 中提取数据。这将为您提供区。使用 Location 即第三列作为 VLOOKUP 的查找文本。

2. 在tbl2 的第 5 列中，再次使用VLOOKUP 从tbl1 中提取数据以获取您的团队。使用 District 即第 4 列作为 VLOOKUP 的查找文本。

假设您的数据如下所示

现在复制tbl2并如下所示粘贴并添加2列District和Team

在单元格D19 中输入公式=VLOOKUP(C19,$C$1:$E$7,2,0)

然后在E19 中输入公式=VLOOKUP(D19,$D$1:$E$7,2,0)

只需拖动公式即可完成。

Answer 3

我找到了上述问题的部分解决方案。

这是扩展 tbl1 以包含来自 tbl2 的数据的解决方案。

为此，我需要计算 tbl1 中的郊区出现在 tbl2 中的次数，我使用 =countif() 进行此操作，然后将每个计数附加到列旁边，如下所示：

然后我使用这篇帖子Insert 'n' number of rows中的代码得到下表：

然后我使用了以下代码：

Sub test()

Dim FindEnd As Range
 
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim text5 As String
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim Text As String
Dim Text4 As String
Dim text2 As String
Dim text3 As String
Dim l As Integer
    
Dim LastRow As Long
Dim address1 As String
Dim address2 As String
 
i = 1
j = 1
k = 1
 
text2 = "start"
text3 = "start2"

Set rng = Sheets("Sheet3").Range("e1:e332")
 
For Each rng2 In rng
    text2 = rng2
    
    If text2 = text3 Then
        i = i + 1
    Else
        i = 1
    End If
    
    Set rng3 = Sheets("test").Range("E:E")
    Set FindEnd = rng3.Find(What:=rng2, LookIn:=xlValues, LookAt:=xlWhole)
    
    address1 = FindEnd.address
    text5 = "E" + CStr(rng2.Row)
    l = Application.WorksheetFunction.CountIf(Range("E1:" + text5), rng2)
    
    Do While j < l
        Set FindEnd = rng3.Find(What:=rng2, LookIn:=xlValues, LookAt:=xlWhole, After:=FindEnd)
        j = j + 1
    Loop
     
    j = 1
    LastRow = FindEnd.Row
    Text = "G" + CStr(LastRow)
    Text4 = "G" + CStr(rng2.Row)
            
    Sheets("Sheet3").Range(Text4).Value = Sheets("test").Range(Text).Value
    k = k + 1
    
    If k = 500 Then
        Exit For
    End If
    
    text3 = rng2

Next rng2
End Sub

要获得这样的表格：

这需要稍微重复/改变以获得“动物”列。

现在正如上面 cmets 中的 @storax 所建议的那样，合并的列可能会成为一个大问题。所以我将它们全部取消合并，然后使用@siddharth 解决方案来填充区域和团队列。

从这里我需要编写一些代码来合并列中的重复项。使用@siddharth 完整解决方案将适用于本示例，但是如前所述，完整数据集要大得多，因此这是一个更可行的解决方案。感谢大家的帮助。如果仍然有兴趣，我也会发布合并的解决方案，但我认为在 stackoverflow 的某个地方会有答案。

再次感谢您的所有意见。