[VBA] 배열의 위치를 출력해보자

새끼새가 어미한테 먹이를 달라고 조르듯 요즘 오픈 채팅방은 아주 난리다.

이글을 읽고 있는 당신도 우리와 함께 하고 싶다면 지금바로 ㄱㄱ

https://open.kakao.com/o/glXWEB3b

유튜브 '엑사남'의 Excel VBA 함께하기

 

문제는 간단하다. 그러나 여기에도 역시 다양한 방법들이 나왔다.

이런 엑셀 그랜드마스터 같은 괴물같은 방법도 나오고(이건 감도 오지 않는다)

 

요즘 열정이 아주그냥 최고인 무지님도 참여하셨고

몇년전 본인을 보는 듯한 딱총님의 풀이도 볼 수 있었다.

본인과 비슷하다고 하면 두분들이 기분나빠 할 수도 있겠지만 암튼 그들의 열정에 박수를 보낸다.

 

여러가지 해법들을 보면서 그들이 얼마나 고민했을지가 눈에 보이기에 본인또한 자극을 받아서

본인 코드를 올린다.

Option Explicit
Sub 배열속_위치()

    Dim Vall: Vall = [b3:g9]
    Dim V, vtemp, key
    Dim i&, j&
    Dim rngX As Range: Set rngX = [b15]
    Dim Dict As Object: Set Dict = CreateObject("scripting.dictionary")
    Dim Al As Object: Set Al = CreateObject("system.collections.arraylist")
    Dim tmr!
    
    tmr = timer                                             '= 시간측정
    
    For i = 1 To UBound(Vall, 1)                            '= 배열의 행방향 순환
        For j = 1 To UBound(Vall, 2)                        '= 배열의 열방향 순환
       
        If Dict.exists(Vall(i, j)) = False Then             '= 딕셔너리 키값 유무 체크
            
            Dict.Add Vall(i, j), "(" & i & "," & j & ")"    '= 키값이 없으면 딕셔너리에 추가
            Al.Add Vall(i, j)                               '= 어레이 리스트에 추가
        Else                                                '= 키값이 있다면 [ / ] 로 이어붙혀라
        
            Dict(Vall(i, j)) = Dict(Vall(i, j)) & "/" & "(" & i & "," & j & ")"
            
        End If
            
        Next j
    Next i
        
    Al.Sort                                                 '= 키값 정렬

    For Each key In Al                                      '= 어레이리스트 순환
        rngX = key                                          '= 키값출력
        vtemp = Array(Split(Dict(key), "/"))                '= 딕셔너리 아이템값들 [/] 로 분리하여 vtemp에 담아라
  
        rngX.Next.Resize(1, UBound(vtemp(0), 1) + 1) = vtemp(0)  '= 키값 옆에 아이템의 크기 만큼 아이템을 출력
        Set rngX = rngX.Offset(1)                           '= 다음행 순환
        
    Next key
     '[b15:g36].SpecialCells(2).Borders.LineStyle = 2
     MsgBox "Haja님의 속도는 " & Format(timer - tmr, "0.000") & "입니다."

End Sub

배열위치문제.xlsm

0.02MB