2015-02-06 58 views
0

我是一个总VBA noob,并一直在努力寻找解决方案,我正在努力实现。我可以在网上找到这些作品,但似乎无法将它们串在一起。真的很感谢一些帮助!VBA复制/粘贴动态行,频率取决于列数

我有以下格式的源文件:

 
+------------+------------+----------+--------+--------+ 
| From |  To  | Job Type | Apples | Orange | 
+------------+------------+----------+--------+--------+ 
| 08/01/2015 | 14/01/2015 | Bought |  1 |  2 | 
| 08/01/2015 | 14/01/2015 | Sold  |  3 |  4 | 
| 01/01/2015 | 07/01/2015 | Bought |  5 |  6 | 
| 01/01/2015 | 07/01/2015 | Sold  |  7 |  8 | 
+------------+------------+----------+--------+--------+ 

我需要一个宏把它转换成以下格式上的另一个工作表:

 
+------------+------------+----------+---------+-------+ 
| From |  To  | Job Type | Product | Count | 
+------------+------------+----------+---------+-------+ 
| 08/01/2015 | 14/01/2015 | Bought | Apples |  1 | 
| 08/01/2015 | 14/01/2015 | Sold  | Apples |  3 | 
| 01/01/2015 | 07/01/2015 | Bought | Apples |  5 | 
| 01/01/2015 | 07/01/2015 | Sold  | Apples |  7 | 
| 08/01/2015 | 14/01/2015 | Bought | Oranges |  2 | 
| 08/01/2015 | 14/01/2015 | Sold  | Oranges |  4 | 
| 01/01/2015 | 07/01/2015 | Bought | Oranges |  6 | 
| 01/01/2015 | 07/01/2015 | Sold  | Oranges |  8 | 
+------------+------------+----------+---------+-------+ 

然而,行数,列是动态的,例如下周“香蕉”也可能作为产品出现,并且或者可能有更多的日期行。

所以我试图复制行的动态范围与发生次数取决于列的数量。

我真的很希望这是有道理的。任何帮助将非常感激。

在此先感谢!

回答

0

下面的代码是否有诀窍?请注意,我推测原始数据位于名为Original的工作表中,而扩展版本位于名为Expanded的工作表中。我创建了非常具有描述性的变量名称,以帮助我的代码更易于遵循,但请发布任何后续问题。

Sub MoveData() 
    Dim wsOriginal As Worksheet 
    Dim wsExpanded As Worksheet 
    Dim nLastRowExpanded As Long 
    Dim nLastRowOriginal As Long 
    Dim nSizeOfCopyRange As Long 

    ' Number of columns we are expanding 
    Const COLUMNS_TO_MOVE As Integer = 2 

    Set wsOriginal = Sheets("Original") 
    Set wsExpanded = Sheets("Expanded") 

    nLastRowOriginal = wsOriginal.Cells(Rows.Count, 1).End(xlUp).Row 
    nSizeOfCopyRange = nLastRowOriginal - 1 

    For i = 1 To COLUMNS_TO_MOVE 
     nLastRowExpanded = wsExpanded.Cells(Rows.Count, 1).End(xlUp).Row + 1 
     wsOriginal.Range("A2:C" & nLastRowOriginal).Copy wsExpanded.Range("A" & nLastRowExpanded) 
     wsExpanded.Range("D" & nLastRowExpanded).Value = wsOriginal.Cells(1, 3 + i).Value 
     wsExpanded.Range("D" & nLastRowExpanded).AutoFill Destination:=wsExpanded.Range("D" & nLastRowExpanded).Resize(nSizeOfCopyRange) 
     wsOriginal.Range("D2:D" & nLastRowOriginal).Offset(, i - 1).Copy wsExpanded.Range("E" & nLastRowExpanded) 
    Next i 

End Sub 
+0

道歉在回答延时按钮,套上了在工作和周末的东西。非常感谢,这绝对是中途。但是,如果源文件包含附加列(例如香蕉),则不会将其复制到“扩展”工作表上。我认为'COLUMNS_TO_MOVE'需要是所有非空列减去3个常数列的数量。再次感谢! – 2015-02-09 09:43:13

0

权,一些与上面的代码(再次感谢,user3561813)修修补补之后,我知道了做什么,我需要。可能有部分的下面是多余的,但如果它不破...

我重视的行动称为“重组”

Private Sub Restructure_Click() 

Worksheets("Original").Activate 

Dim wsOriginal As Worksheet 
Dim wsExpanded As Worksheet 
Dim nLastRowExpanded As Long 
Dim nLastRowOriginal As Long 
Dim nSizeOfCopyRange As Long 
Dim lastColumn As Long 

Set wsOriginal = Sheets("Original") 
Set wsExpanded = Sheets("Expanded") 

lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column 

Dim DATARANGE As Range 
Set DATARANGE = Range(Cells(1, 4), Cells(1, lastColumn)) 

nLastRowOriginal = wsOriginal.Cells(Rows.Count, 1).End(xlUp).row 
nSizeOfCopyRange = nLastRowOriginal - 1 

For i = 1 To DATARANGE.Count 

    nLastRowExpanded = wsExpanded.Cells(Rows.Count, 1).End(xlUp).row + 1 
    wsOriginal.Range("A2:C" & nLastRowOriginal).Copy wsExpanded.Range("A" & nLastRowExpanded) 
    wsExpanded.Range("D" & nLastRowExpanded).Value = wsOriginal.Cells(1, 3 + i).Value 
    wsExpanded.Range("D" & nLastRowExpanded).AutoFill Destination:=wsExpanded.Range("D" & nLastRowExpanded).Resize(nSizeOfCopyRange) 
    wsOriginal.Range("D2:D" & nLastRowOriginal).Offset(, i - 1).Copy wsExpanded.Range("E" & nLastRowExpanded) 
Next i 

End Sub