'찾는 내용이 포함된 셀'에 해당되는 글 1건

찾는 내용이 포함된 셀의 행 가져오기 VBA

찾는 셀의 내용이 입력한 텍스트와 100% 일치하는 경우는 앞 게시물에서 다뤘구요.

지금 다루는 사항은 입력한 텍스트가 포함된 셀이 있는 경우만 찾아서 복사하라는 VBA 코드입니다.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String
   
    If Target.Address <> "$A$2" Or IsEmpty(Target) Then Exit Sub
    Application.ScreenUpdating = False      '// 화면 업데이트 중지
    Sheets("Sheet2").Range("A5").CurrentRegion.Offset(1).Clear   '// 기존 데이터를 전부 삭제
    Set rngAll = Sheets("data").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(3) '// 전체범위에서 선택할 열 3은 C열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1) '// A2 행부터 범위 재지정

    With Sheets("Sheet2")  '// 해당 시트명 직접 입력, ActiveSheet 로 하면 됨

        If WorksheetFunction.CountIf(rngC, "*" & Target & "*") = 0 Then
            MsgBox " 찾는 자료가 없습니다! ", 64, "입력오류 "
            Exit Sub
        Else
            rngC.AutoFilter Field:=1, Criteria1:="*" & Target & "*", VisibleDropDown:=False
            '// Target 포함된 행만 선별
            rngAll.Copy .Cells(Rows.Count, "A").End(3)(2)
            '// 자동 필터된 값을 시트의 마지막 아래행에 복사하라
        End If
    End With
    rngC.AutoFilter  '// 자동필터 해제
    Columns.AutoFit  '// 열너비 자동 맞춤

    Set rngAll = Nothing  '// 변수 초기화
End Sub

의미파악 :

어떤 Sheet 인지를 직접 다 적어주면 다른 Sheet 에서 결과를 실행해도 원하는 결과를 찾을 수 있습니다.

굵은 글씨나 색상이 다르게 표시된 부분을 눈여겨 보면 됩니다.

Columns(3) 은 3번째 열에서 찾을 내용이 있을 경우이므로, 만약 다른 열에 있다면 이 부분 숫자를 변경하면 됩니다.

가져가서 수정해서 쓴다면 파란색 부분만 상황에 맞게 수정하면 나머지는 수정하지 않아도 동작할 것입니다.

Fetch of Finding Cell.vbs

계속 배우는 중이라 생각한대로 동작이 안되거나 확인이 필요하면 F8키를 눌러가면서 일일이 어떤 동작의 변화가 발생하는지 체크를 하면서 정리중입니다.

위의 코드는 F8키를 눌러가면서 하면 에러가 발생합니다.

아래처럼 A2 셀에 입력한 값을 지정하고 F8키를 눌러가면서 실행을 합니다.

무조건 복사하여 이용하는 것보다 어떻게 변화하고 움직이는지 도움이 되기 때문에 상황에 맞게 응용하여 사용할 수가 있게 됩니다.

Sub AutoFilter_Copy()

    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String

    Dim fstRow As Range   '// 첫줄 복사하기 위한 범위 지정 변수

    Target = Sheets("Sheet2").Cells(2, 1).Value      '// 조건 검색어

    If IsEmpty(Target) Then Exit Sub

    Application.ScreenUpdating = False      '// 화면 업데이트 중지

    Set fstRow = Sheets("data").Range("A1")  '// 복사할 범위의 첫셀 지정

    Range(fstRow, fstRow.End(2)).Copy Sheets("Sheet2").Range("A5")  '// 첫줄을 복사하여 Sheet2의 A5에 복사

    Sheets("Sheet2").Range("A5").CurrentRegion.Offset(1).Clear   '// 기존 데이터를 전부 삭제
    Set rngAll = Sheets("data").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(3) '// 전체범위에서 선택할 열 3은 C열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1) '// A2 행부터 범위 재지정

    With Sheets("Sheet2")  '// 해당 시트명 직접 입력, ActiveSheet 로 하면 됨

        If WorksheetFunction.CountIf(rngC, "*" & Target & "*") = 0 Then
            MsgBox " 찾는 자료가 없습니다! ", 64, "입력오류 "
            Exit Sub
        Else
            rngC.AutoFilter Field:=1, Criteria1:="*" & Target & "*", VisibleDropDown:=False
            '// Target 포함된 행만 선별
            rngAll.Copy .Cells(Rows.Count, "A").End(3)(2)
            '// 자동 필터된 값을 시트의 마지막 아래행에 복사하라
        End If
    End With
    rngC.AutoFilter  '// 자동필터 해제
    Columns.AutoFit  '// 열너비 자동 맞춤

    Set rngAll = Nothing  '// 변수 초기화
End Sub