Question

我试图以一种能够为我节省无数繁琐数据的方式来自动化Excel。这是我的问题。

我们有适合许多不同年份车型的摩托车零件。我正在使用的文件包含单元格中的年份列表。这些年可能连续也可能不连续。他们被＆＃34;，＃34;分开。我需要一种方法来查看列出的年份数，并多次复制数据行。

我还需要它为每一行提供一年的时间。在下面的例子中，最后一栏是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将通过双循环执行您需要的操作。改变＆＃34; Sheet1＆＃34;和＆＃34; Sheet2＆＃34;以满足您的实际需求。请记住将第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列。在这种情况下，您需要更改循环中的第2行以进入在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

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

2 个答案: