나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내

작성자:  

 opww (azz5303)

추천:  2
파일:     조회:  1910
제목:   코드수정좀 부탁드립니다.
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007):2007

* 아래줄에 질문을 작성하세요 >>

Sub Button1_Click()
 Dim rng As Range, rngName As Range
 Dim rngRow As Range
 Dim strFind As String
 Dim r As Integer
 
 Set rngName = Columns("A").SpecialCells(xlCellTypeConstants)
 Set rngRow = Sheet2.Range("A2:C2")
  strFind = "4001 "
  Range(rngRow, rngRow.End(xlDown)).ClearContents
  For Each rng In rngName
 If InStr(rng, strFind) > 0 Then
    rngRow.Offset(r, 0) = rng.Offset(0, 0).Resize(, 3).Value
   r = r + 1


End If
Next rng
 
   Set rngName = Columns("A").SpecialCells(xlCellTypeConstants)
 Set rngRow = Sheet3.Range("A2:C2")
  strFind = "4002 "
  Range(rngRow, rngRow.End(xlDown)).ClearContents
  For Each rng In rngName
   If InStr(rng, strFind) > 0 Then
    rngRow.Offset(r, 0) = rng.Offset(0, 0).Resize(, 3).Value
r = r + 1

 End If
  Next rng
  
     Set rngName = Columns("A").SpecialCells(xlCellTypeConstants)
 Set rngRow = Sheet4.Range("A2:C2")
  strFind = "4005"
  Range(rngRow, rngRow.End(xlDown)).ClearContents
  For Each rng In rngName
   If InStr(rng, strFind) > 0 Then
    rngRow.Offset(r, 0) = rng.Offset(0, 0).Resize(, 3).Value
r = r + 1
   End If
   Next rng
   
End Sub



해당코드는 특정단어포함한 행을 원하는 시트로옮겨주는 코드입니다.



그런데 첫번째 4001 단어를포함한 행은 다른시트로옮겨주나 4002,4005는 안되는대요



4002,4005도 작업이되도록 코드수정좀 부탁드립니다
 
[불량 게시물 신고]  
조삿갓옮겨지지 않은 게 아니고, Sheet3을 아래로 쭈욱 스크롤시켜보면 쩌그 아래만치 옮겨진 데이터가 까꿍! 할 거 같은데요?
예컨대 Sheet2에 옮겨진 데이터가 1,000개라면
Sheet3에는 1,001행 째부터 데이터가 있을 겁니다.

그 이유는 변수 r을 초기화시키지 않고 계속 증가만 시켰기 때문입니다.

각 Next rng 명령 다음에 r = 0 명령을 추가해 보세요.
02-14 (14:23)
삭제 ■신고
조삿갓그리고, 코드가 중복, 반복된 게 많아 비효율적입니다.
Array 함수를 이용한 배열변수를 적절히 활용하면
For Each 반복문을 사용하여 세 개의 중복 루틴을
하나의 반복문으로 축약할 수 있습니다.

다음 자료 참고하여 연구해 보시기 바랍니다.

http://www.officetutor.co.kr/board/Dtype/bfrmvw.asp?f_tn=Dqa_excel_n2&f_bno=123379&page=
02-14 (14:25)
삭제 ■신고
        
  

작성일 : 2018-02-14(11:22)
최종수정일 : 2018-02-14(11:22)