根据单元格值复制或复制数据行

Question

我正在尝试以一种可以节省无数小时繁琐数据输入的方式来自动化 Excel。这是我的问题。

我们的摩托车零件可以安装在许多不同年份的车型上。我正在使用的文件有一个单元格中的年份列表。这些年可能是连续的，也可能不是连续的。它们用“，”隔开。我需要一种方法来查看列出了多少年并复制该行数据的次数。

我还需要它为每一行只给出一年。在下面的示例中，最后一列是 FITMENT YEARS；如您所见，它有 3 个不同的年份，每个年份用逗号分隔。在这种情况下，它只有 3 年，可能是 10 个不同的年份，也可能只是一年。

这是我所拥有的单行：

P/N Make    Mfg Model   Year Span   Fitment Years
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2010, 2011, 2012

这就是我需要列出的方式：

P/N Make    Mfg Model   YearSpan    Fitment Years
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2010
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2011
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2012

我真的需要别人的帮助。我不知道如何继续。 谢谢

Answer 1

试试这个。

将以下例程放入标准代码模块并运行它。

重要提示：这会就地替换您的数据，因此请确保在运行此之前您有一份副本。

Sub Jnowell()
    Dim c&, n&, v, y
    With [a2]
        c = 1
        Do
            If Len(.Item(c)) Then
                y = Split(.Item(c, 4), ", ")
                If UBound(y) Then
                    .Item(c)(2).Resize(UBound(y), 4).Insert xlDown
                    v = .Item(c).Resize(, 4)
                    .Item(c, 4) = y(0)
                    For n = 1 To UBound(y)
                        .Item(c)(n + 1).Resize(, 4) = v
                        .Item(c, 4)(n + 1) = Left$(y(0), Len(y(0)) - 4) & y(n)
                    Next
                End If
            Else
                Exit Do
            End If
            c = c + 1
        Loop
    End With
End Sub

注意：此例程假定您的数据位于当前活动工作表的 A、B、C 和 D 列中。

Answer 2

如果您的数据存在于 A:D 列中，您的原始列表在 Sheet1 上，并且您想在 Sheet2 上创建新列表，那么下面的 vba 将通过双循环完成您需要的操作。更改“Sheet1”和“Sheet2”以满足您的实际需要。请记住将工作表 2 上的 C 列格式化为文本或 Excel 会自动将该数据转换为日期...

Sub CreateYearList()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Sheets("Sheet2").Range("A1:D1").Value = Sheets("Sheet1").Range("A1:D1").Value
    Dim CmCt As Integer
    Dim NRwCt As Integer
    Dim ORwCt As Integer
    Dim LArray() As String
    Dim Yr As String
    ORwCt = WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A"))
    For i = 2 To ORwCt
        LArray = Split(Sheets("Sheet1").Range("D" & i).Value, ",")
        CmCt = Len(Sheets("Sheet1").Range("D" & i).Value) - Len(Replace(Sheets("Sheet1").Range("D" & i).Value, ",", ""))
        NRwCt = WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))
        For n = 1 To CmCt + 1
            Yr = LArray(n - 1)
            Sheets("Sheet2").Range("A" & NRwCt + n & ":C" & NRwCt + n).Value = Sheets("Sheet1").Range("A" & i & ":C" & i).Value
            Sheets("Sheet2").Range("D" & NRwCt + n).Value = Yr
        Next n
    Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

对于其他字段，您只需更改 n 循环中的行以包含您范围内的任何其他字段。如果它们环绕您的 Fitment Years 列，那么您可以在该循环中添加第二行的额外副本并将其更改为包含该列之外的任何范围。

例如，假设您的 Fitment Years 列实际上是 F 列中的列，而其他字段转到 Z 列。在这种情况下，您需要更改循环中的第二行以上升到 Fitment 之前的列Years (E)，并添加第二行的副本，该行查看 Fitment Years (G) 之后的列并一直到 Z。您可以使用这些行来代替：

        Sheets("Sheet2").Range("A" & NRwCt + n & ":E" & NRwCt + n).Value = Sheets("Sheet1").Range("A" & i & ":E" & i).Value
        Sheets("Sheet2").Range("F" & NRwCt + n).Value = Yr
        Sheets("Sheet2").Range("G" & NRwCt + n & ":Z" & NRwCt + n).Value = Sheets("Sheet1").Range("G" & i & ":Z" & i).Value