엑셀 매크로 VBA 11. 나의 함수 : 선택된세로줄에서 중복제거한 데이타를 새로운 위치에 넣기 소스코드

엑셀 매크로 VBA 11. 나의 함수 : 선택된세로줄에서 중복제거한 데이타를 새로운 위치에 넣기 소스코드

선택된세로줄에서 중복제거한 데이타를 새로운 위치에 넣기

Option Explicit

Sub 선택값중중복피하여새로운곳에넣기()

    Dim AreaStr(1 To 5000) As String

    Dim ASlen As Integer

    Dim curval As String

    Dim i As Integer

    Dim j As Integer

    Dim last As Integer

    Dim dcol As Object

    Dim tf As Boolean

   

    Dim sela1 As Range

    Dim startx As Long

    Dim starty As Long

    Dim lenx As Long

    Dim leny As Long

    

    On Error GoTo ERR1

    Set sela1 = Application.InputBox(Type:=8, prompt:="영역을 한 줄로 선택하세요 ?" & Chr(13) & Chr(13) & "자료의 한계는 5000개", Title:="중복피하기")

    

    startx = CLng(sela1.Column)

    starty = CLng(sela1.row)

    lenx = CLng(sela1.Columns(sela1.Columns.Count).Column) - CLng(sela1.Column) + 1

    leny = CLng(sela1.Rows(sela1.Rows.Count).row) - CLng(sela1.row) + 1

    last = leny

    Set dcol = sela1

    For i = 1 To last

        curval = dcol.Cells(i, 1).Value

        tf = False

        For j = 1 To last

            If AreaStr(j) = curval Then

                tf = True   ' 값이 이미 있슴.

                Exit For

            Else            ' 동일한 값이 없슴.

                tf = False

                If j >= ASlen And Len(Trim(curval)) > 0 Then

                    ASlen = ASlen + 1

                    AreaStr(ASlen) = curval

                    Exit For

                End If

            End If

        Next j

    Next i

    

    ' 갯수만큼 반복한다.

        Set sela1 = Application.InputBox(Type:=8, prompt:="셀중 한 곳만을 선택하세요 ?", Title:="중복피하기")

        sela1.Select

    For i = 1 To ASlen

        ActiveCell.Value = AreaStr(i)

        ActiveCell.Offset(1, 0).Select

    Next i

ERR1:

End Sub

Sub 선택값중중복피하여새로운곳에갯수까지넣기()

    Dim AreaStr(1 To 5000) As String

    Dim AreaNum(1 To 5000) As Integer

    Dim ASlen As Integer

    Dim curval As String

    Dim i As Integer

    Dim j As Integer

    Dim last As Integer

    Dim dcol As Object

    Dim tf As Boolean

   

    Dim sela1 As Range

    Dim startx As Long

    Dim starty As Long

    Dim lenx As Long

    Dim leny As Long

    

    On Error GoTo ERR1

    Set sela1 = Application.InputBox(Type:=8, prompt:="영역을 한 줄로 선택하세요 ?" & Chr(13) & Chr(13) & "자료의 한계는 5000개", Title:="중복피하기")

    

    startx = CLng(sela1.Column)

    starty = CLng(sela1.row)

    lenx = CLng(sela1.Columns(sela1.Columns.Count).Column) - CLng(sela1.Column) + 1

    leny = CLng(sela1.Rows(sela1.Rows.Count).row) - CLng(sela1.row) + 1

    last = leny

    Set dcol = sela1

    For i = 1 To last

        curval = dcol.Cells(i, 1).Value

        tf = False

        For j = 1 To last

            If AreaStr(j) = curval Then

                AreaNum(j) = AreaNum(j) + 1

                tf = True   ' 값이 이미 있슴.

                Exit For

            Else            ' 동일한 값이 없슴.

                tf = False

                If j >= ASlen And Len(Trim(curval)) > 0 Then

                    ASlen = ASlen + 1

                    AreaStr(ASlen) = curval

                    AreaNum(ASlen) = AreaNum(ASlen) + 1

                    Exit For

                End If

            End If

        Next j

    Next i

   

    

    ' 갯수만큼 반복한다.

        Set sela1 = Application.InputBox(Type:=8, prompt:="셀중 한 곳만을 선택하세요 ?", Title:="중복피하기")

        Worksheets(sela1.Worksheet.Name).Select

        sela1.Select

    For i = 1 To ASlen

        ActiveCell.Value = AreaStr(i)

        ActiveCell.Offset(0, 1).Value = AreaNum(i)

        ActiveCell.Offset(1, 0).Select

    Next i

ERR1:

End Sub

.