[기초방] VBA 100제 #32 [ 이름조합하기 ]

과제문제 낼때 신규 이름 생성하기가 힘들어서 만든 과제이다. 이제 저 이름으로 조합하여 문제를 낼려고 한다..ㅋㅋㅋ

 

조합한 이름을 TXT 파일로 바탕화면에 추출하는 코드를 만들어보자

Option Explicit

Sub 조합()

    Dim nameLs As Range: Set nameLs = [c4]                                  '= 이름의 성 부문
    Dim nameFs As Range: Set nameFs = [c5]                                  '= 이름의 이름 부문
    Dim VtempLs, VtempFs
    Dim fName$, str$
    Dim Cnt&: Cnt = 1
    
    Do
    
    VtempLs = Split(nameLs, " "): VtempFs = Split(nameFs, " ")              '= 각 공백으로 분리하여 성 / 이름 배열에 담아라
    
    fName = VtempLs(WorksheetFunction.RandBetween(0, UBound(VtempLs))) & _
            VtempFs(WorksheetFunction.RandBetween(0, UBound(VtempFs)))      '= 성과 이름의 랜덤 조합
    
    If InStr(str, fName) = 0 Then                                           '= 이름들의 조합중 신규 이름이 있는지 없는지에 대한 조건문
                                                                            '= 이름이 있으면 중복 /  없으면 신규
        str = IIf(str = "", fName, str & "," & fName)                       '= 이름 조합
        Cnt = Cnt + 1                                                       '= 루프 탈출을 위한 카운트
        
        If Cnt > 100 Then Exit Do                                           '= 카운트가 100 초과이면 루프탈출
        
    End If
    
    Loop

    [c7].Resize(100, 1) = Application.Transpose(Split(str, ","))            '= 조합된 콤마로 연결된 str을 분리하여 행렬변환시켜라
    
    Haja_ExportToDesktop
    
End Sub
Sub Haja_ExportToDesktop()

    Dim FileNum&
    Dim DesktopPath$
    Dim FilePath$
    Dim rngAll As Range: Set rngAll = Range([c7], [c7].End(4))
    Dim rngA As Range
    
    DesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")   '= 개인적인 바탕화면
    FilePath = DesktopPath & "\이름조합.txt"                                 '= 샘플 텍스트파일을 만듦

    FileNum = FreeFile()
    Open FilePath For Output As #FileNum
    
    For Each rngA In rngAll
    
        Print #FileNum, rngA                                                '= 이름영역을 텍스트파일에 출력함
        
    Next rngA

    Close #FileNum

End Sub

때로는 이렇게 날로 먹을때도....

 

기초방32.xlsm

0.02MB