0

有没有办法自动检查一个单元格（在这种情况下是一年，即 2008 年到 2013 年），当匹配完成时执行剪切和粘贴，基本上对在一系列单元格中找到的数据进行排序（就在年份的右边) 成列？在同一行进一步。

SO18738548 问题示例

编辑

好的团队我似乎已经弄清楚如何手动完成，请参阅代码的缩写部分

If ActiveCell = 2013 Then
ActiveCell.Offset(, 2).Range("A1:E1").Select
Selection.Cut
ActiveWindow.SmallScroll ToRight:=24
ActiveCell.Offset(0, 24).Range("A1").Select
ActiveSheet.Paste
End If

If ActiveCell = 2012 Then
ActiveCell.Offset(, 2).Range("A1:E1").Select
Selection.Cut
ActiveWindow.SmallScroll ToRight:=18
ActiveCell.Offset(0, 18).Range("A1").Select
ActiveSheet.Paste
End If

现在如何自动化？

第二次编辑...

好的团队我已经用下面的代码解决了这个问题，感谢这里的人指出我正确的方向......干得好......

Option Explicit

Sub NoTears()

Dim c As Range
Dim lastrow As Long

lastrow = Range("F" & Rows.Count).End(xlUp).Row

For Each c In Range("F1:C" & lastrow)

 Select Case c.Value

 'Case Is = 2009
 '   c.Offset(0, 2).Resize(1, 5).Cut Cells(Rows.Count, "??") _
       .End(xlUp).Offset(1)

Case Is = 2010
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=8
    c.Offset(0, 8).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2011
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=14
    c.Offset(0, 14).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2012
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=20
    c.Offset(0, 20).Range("A1").Select
    ActiveSheet.Paste

Case Is = 2013
    c.Offset(, 2).Range("A1:E1").Select
    Selection.Cut
    ActiveWindow.SmallScroll ToRight:=26
    c.Offset(0, 26).Range("A1").Select
    ActiveSheet.Paste

  End Select
Next
End Sub
4

1 回答 1

0

我会做这样的事情：

未测试

Dim Cell As Range
Dim lastRow as Long

lastRow = Range("F:F").Find("*", Range("F4"), searchdirection:=xlPrevious).Row 'this finds the last row in column F that contains data

For Each Cell In Range("F4:F" & lastrow) 'Loop through the whole table
    Select Case Cell
        Case 2008 'If the cell contains 2008 then...
            lastRow = Range("AD:AD").Find("*", Range("AD4"),searchdirection:=xlPrevious).Row 'Find the last used row in your new table
            Range(Cells(Cell.Row,8),Cells(Cell.Row,12).Copy Cells(lastRow + 1,30) 'Copy/paste the data into your new table
        Case 2009
            'Same concept as before
    End Select
Next Cell

未测试

您将需要修改它以满足您的需要。具体来说，您需要更新列和偏移数字以正确匹配您的数据和表（我尝试了我的最佳猜测，但我可能会关闭）。

于 2013-09-11T18:08:52.557 回答