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)' 카테고리의 다른 글

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