일치하는 연도를 자동화 한 다음 잘라 내기 및 붙여 넣기

셀 (이 경우 2008 년에서 2013 년까지)을 자동으로 검사하는 방법이 있으며 일치하는 항목을 잘라내어 붙여 넣기를 실행하면 본질적으로 열의 셀 범위 (올해 오른쪽)? 같은 줄에 더 가라.일치하는 연도를 자동화 한 다음 잘라 내기 및 붙여 넣기

SO18738548 question example

편집

내가 수동으로 작업을 수행하는 방법을 알아 낸 것 좋아 팀은 지금

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

출처

2013-09-11 totalpackage

예, 있습니다. – mango

나는 조금 더 세게 보이는 커뮤니티 반응이라고 생각합니까? – totalpackage

커뮤니티는 무정형이므로 아무도 모든 것을 말하지는 않지만 "코드를 묻는 질문은 해결해야 할 문제에 대해 최소한의 이해를 보여 주어야합니다 **."시도한 해결책을 포함하고 작동하지 않는 이유를 반복해서 지루하게 지루합니다. 예상 * 결과. " 코드를 요청할 때 매크로 레코더 등으로 찌르기를하고, 어디서 붙어 있는지, 어떤 오류 메시지가 언제 어디서 왔는지 등을 알려주는 것이 좋습니다. – pnuts

나는 같은 것을 할 것입니다 :

을 테스트하지

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-11 18:08:52 ARich

일치하는 연도를 자동화 한 다음 잘라 내기 및 붙여 넣기

답변

관련 문제