ABOUT ME

-

Today
-
Yesterday
-
Total
-
  • 유효성검사 유일값 가져오기
    VB(A) 2021. 1. 19. 10:28

    https://cafe.naver.com/excelmaster/190699의 질문으로

    '발주번호'를 이용하여 '로데이터' 시트에 있는 자료를 가져오는 내용입니다.

     

    1. 로데이터 시트의 발주번호 중 중복값은 제거하여 A3 셀에 유효성검사를 이용하여 발주번호를 선택하여

    2. 고급필터로 필요한 데이터를 출력합니다.

    샘플_업로드.xlsm
    0.02MB

     

    Option Explicit
     
    Sub 매크로2()
    '고급필터 매크로
     
        Dim rawData As Worksheet
        Dim templateSheet As Worksheet
        Dim conditionRange As Range
        Dim printRawData As Range
        
        '시트 및 셀 영역 설정
        Set rawData = Sheets("로데이터 시트")
        Set templateSheet = Sheets("템플릿")
        Set conditionRange = templateSheet.Range("A2:A3")
        Set printRawData = templateSheet.Range("A10:I10")
        
        '기존 자료 삭제
        templateSheet.Range("A10").CurrentRegion.Offset(1).ClearContents
        
        '고급필터로 필요한 자료 출력
        rawData.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=conditionRange, CopyToRange:=printRawData, Unique:=False
    End Sub
     
     
    Sub Uniq_Data_Val()
    '기존자료 삭제 후 로데이터 시트의 발주번호 중 중복값을 제거하여
    '유효성검사 목록에 삽입하는 매크로
     
        Dim i As Integer: i = 2
        Dim arr As Variant
        Dim rg As Object
        Dim rawData As Worksheet
        Dim templateSheet As Worksheet
        Dim Last_ro%: Last_ro = Cells(Rows.Count, 1).End(3).Row
        
        '변수 설정
        Set rawData = Sheets("로데이터 시트")
        Set templateSheet = Sheets("템플릿")
        
        '기존 자료 삭제
        templateSheet.Range("A10").CurrentRegion.Offset(1).ClearContents
        
        '발주번호의 고유값만 추출
        Set rg = CreateObject("System.Collections.Arraylist")
        With rg
            Do Until i > Last_ro
                If rawData.Range("a" & i) <> vbNullString _
                     And Not .Contains(rawData.Range("a" & i).Value) Then
                    .Add rawData.Range("a" & i).Value
                End If
              i = i + 1
            Loop
          .Sort
          arr = .toarray
          arr = Join(arr, ",")
         End With
         
         '유효성검사에 발주번호 출력
         With Range("A3")
            .ClearContents
            With .Validation
                .Delete
                .Add xlValidateList, Formula1:=arr
            End With
         End With
    End Sub
     
     
    cs

    'VB(A)' 카테고리의 다른 글

    시트 숨기기 일괄 처리  (2) 2021.04.19
    공휴일 적용된 달력  (0) 2021.02.10
    미디어 파일을 날짜별로 분류  (6) 2019.12.25
    경품 추첨  (8) 2019.06.26
    여러 개의 텍스트박스를 클릭하여 이름 알아내기  (0) 2019.06.17

    댓글