Question

我有一个表，其中包含一组必须分解成其组件的捆绑包。为此，我正在寻找VBA指令，该指令将在'sku'单元末尾（例如，请参见下面的表格）将其下两次复制包含标签“ -edubnd”的任何行。

忽略标签组件并使用代码查找的一组特定值可能会更容易，这也是可能的，因为标记为bundles的值在列中始终相同。我的意思是，代码只寻找该列中的特定值，而不是寻找-edubnd标记

我在下面创建了一个示例表，该表与excel中的表相似，足以说明问题。

我当前正在过滤数据集，将其复制到另一个excel文档中，然后运行以下命令：

Sub insertrows()
    Dim I As Long
    Dim xCount As Integer

LableNumber:
    xCount = 2
    For I = Range("A" & Rows.CountLarge).End(xlUp).Row To 1 Step -1
        Rows(I).Copy
        Rows(I).Resize(xCount).Insert
    Next
    Application.CutCopyMode = False
End Sub

当前表：

column1   |    column2    |  column3 |  column3
----------------------------------------------
  A       |      pear     |  blue    |  10
  A       |      apple    |  orange  |  50
  A       |      orange   |  yellow  |  30
  A       |      kiwi     |  yellow  |  20
  A       | orange-edubnd |  blue    |  100
  A       |      apple    |  green   |  10
  A       |  pear-edubnd  |  green   |  50
  A       |      mango    |  pink    |  60

所需表

注意：每个带有-edubnd标签的独立列之后的复制行2

 column1   |    column2    |  column3 |  column3
----------------------------------------------
  A       |      pear     |  blue    |  10
  A       |      apple    |  orange  |  50
  A       |      orange   |  yellow  |  30
  A       |      kiwi     |  yellow  |  20
  A       | orange-edubnd |  blue    |  100
  A       | orange-edubnd |  blue    |  100
  A       | orange-edubnd |  blue    |  100
  A       |      apple    |  green   |  10
  A       |  pear-edubnd  |  green   |  50
  A       |  pear-edubnd  |  green   |  50
  A       |  pear-edubnd  |  green   |  50
  A       |      mango    |  pink    |  60

Answer 1

在Excel工作表的GUI菜单上，这称为“插入复制的单元格”。

union OptionalInt {
    int Value;
    bool IsNull;
};

union OptionalInt ParseHex(char *Str) {
    //...
    if(/*Success*/) {
        return (union OptionalInt){/*Value*/, 0};
    }else{
        return (union OptionalInt){0, 1};
    }
}

Answer 2

请在对其参数进行适当修改后尝试使用此代码。

Sub InsertDuplicates()

    Const TestClm As String = "B"               ' modify as appropriate
    Const SearchCrit As String = "edubnd"

    Dim R As Long

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("InsRows")     ' change as appropriate
        For R = .Cells(.Rows.Count, TestClm).End(xlUp).Row To 2 Step -1
            If InStr(1, .Cells(R, TestClm).Value, SearchCrit, vbTextCompare) Then
                .Rows(R).EntireRow.Copy
                .Range(.Rows(R + 1), .Rows(R + 2)).Insert Shift:=xlDown
                Application.CutCopyMode = False
            End If
        Next R
    End With
    Application.ScreenUpdating = True
End Sub

如何使用VBA在单元格中的特定值之后自动插入复制的行

当前表：

所需表

2 个答案: