728x90

엑셀 파일 다운로드

여학생70점이상만 복사.xlsm

0.02MB

Sub Test_01()

Dim lngE As Long
Dim rngD As Range
Dim i As Long

lngE = Cells(Rows.Count, "b").End(xlUp).Row

    For i = 3 To lngE
        If Range("e" & i) = "여" Then
            If rngD Is Nothing Then
                Set rngD = Range("e" & i).Offset(0, -3).Resize(1, 10)
            Else
                Set rngD = Union(rngD, Range("e" & i).Offset(0, -3).Resize(1, 10))
            End If
        End If
    Next

    If rngD Is Nothing Then
        MsgBox "복사할 범위가 없습니다."
    Else
        Range("p3").CurrentRegion.Offset(1, 0).Clear
        rngD.Copy Range("p3")
    End If
Range("a1").Select
End Sub
Sub Test_03()

Dim lngE As Long
Dim rngD As Range
Dim i As Long

lngE = Cells(Rows.Count, "b").End(xlUp).Row

     For i = 3 To lngE
          If Range("e" & i) = "여" And Range("k" & i) >= 60 Then
                   '여학생이면서 평균 60점 이상
               If rngD Is Nothing Then
                    Set rngD = Range("e" & i).Offset(0, -3).Resize(1, 10)
                   'rngD.Select
                        '단계별 실행에서 확인용
               Else
                    Set rngD = Union(rngD, Range("e" & i).Offset(0, -3).Resize(1, 10))
                    'rngD.Select
                        '단계별 실행에서 확인용
     
          End If
          End If
     Next

     If rngD Is Nothing Then
          MsgBox "복사할 범위가 없습니다."
     Else
          Range("p3").CurrentRegion.Offset(1, 0).Clear
          rngD.Copy Range("p3")
     End If

Range("a1").Select
End Sub

 



출처: https://withseok.tistory.com/266 [with Seok]


'VBA' 카테고리의 다른 글

[VBA] Extract Unique Value (Distinct)  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23

+ Recent posts