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

我试图以一种方式自动化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

我真的很需要别人的帮助。我迷失在如何继续。谢谢

来源

2015-10-13 Jnowell

这是一个有点大的问题 - 你试图自己解决这个问题吗？另外要说明的是：原始格式的数据总是在数据的末尾？另外 - 这种情况下会不断增加新的部件，或者您当前的数据集每年都包含几乎每个新部件的所有内容？ –

计算逗号的数量，插入多行，填入插入的行，使用'split'获得年份。 – findwindow

或者，没有VBA，计数逗号，并有一个新的列计数运行在每个连续行中找到的所有逗号的总数。然后放入一个索引，该索引从另一个选项卡上的1-总共逗号计数;使用INDEX/MATCH从第一个选项卡中的每一行中提取数据，并通过确定哪一年是在＃后面的逗号后查找年份。 –

如果您的数据存在列A：D，您的原始列表在Sheet1上，并且您希望在Sheet2上创建新列表，那么以下vba将按照双循环执行您所需的操作。更改“Sheet1”和“Sheet2”以满足您的实际需求。请记住，在片2的文本或Excel会自动打开该数据转换成日期格式列C ...

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行以便到达列之前装修年（E），并加入2号线，着眼于（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

来源

2015-10-13 18:30:39

这项工作有点但我有更多的领域需要复制。我会玩这个公式，看看我能不能解决这个问题。我真的非常感谢你的帮助。非常感谢。它给了我一个开始的地方。 – Jnowell

我更新了我的答案，以包含您需要更改以包含其他字段的解释。 –

试试这个。

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

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

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列中。

来源

2015-10-13 18:33:35

感谢您的意见，我感谢您的帮助。 – Jnowell

@Jnowell如果您需要帮助，请联系我。我的电子邮件地址是：[email protected] –

@Jnowell你有这个工作吗？我来帮忙！ –

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

回答

相关问题