반응형
Notice
Recent Posts
Recent Comments
«   2024/05   »
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
Archives
Today
Total
관리 메뉴

Do Something IT

VBScript Sort Excel String Lenght 본문

OtherLanguage

VBScript Sort Excel String Lenght

아낙시만더 2017. 11. 22. 11:18
반응형
해당 셀에 있는 스트링을 문자열 길이로 정렬하기
Sub sort()

    Set thisSheet = ActiveSheet
    'arrTargetFileName = Array("tsetWorkBook.xlsx", "tsetWorkBook2.xlsx")
    '========================== 타겟 에서 데이터를 읽어옴 =======================
    '========================== 변수 선언 =======================
    columnA = "A"

    arr = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")
    
    
    nRowStartIdx = 4
    nColumnStartIdx = 4
     
    nRowIdx = 0
    nColumnIdx = nColumnStartIdx
    
    '========================== 타겟 열기 =======================
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True
   
    'For k = 0 To arrTargetFileName.Count
        'Set objWorkbook = objExcel.Workbooks.Open(ThisWorkbook.Path + arrTargetFileName(k))
     'Path = Replace(ThisWorkbook.Path, "Tool", "")
     Path = ThisWorkbook.Path & "\" & thisSheet.Cells(1, 6).Value
     
     '.\..\
     'MsgBox Path
     'Path = ".\..\"
     Set objWorkbook = objExcel.Workbooks.Open(Path)
     Set targetSheet = objWorkbook.Sheets(1)
     
     '========================== 마지막 위치를 확인 =======================
     Lst_col = objWorkbook.Sheets(1).Cells(nColumnStartIdx, nRowStartIdx).End(XlDirection.xlToRight).Column
    
     '========================== 복사 ==========================
     For i = 0 To Lst_col - nColumnStartIdx
         '========================== 마지막 위치를 확인 =======================
         Lst_row = targetSheet.Cells(nRowStartIdx, nColumnStartIdx + i).End(XlDirection.xlDown).Row
          thisSheet.Range(arr(0) & nRowStartIdx & ":" & arr(0) & Lst_row).Value = targetSheet.Range(arr(i) & nRowStartIdx & ":" & arr(i) & Lst_row).Value
       
             For j = nRowStartIdx To Lst_row
                 thisSheet.Range(columnA & j) = "=LEN(" & arr(0) & j & ")"
             Next
         
         thisSheet.Range("A" & nRowStartIdx & ":D" & Lst_row).sort key1:=Range(columnA & nRowStartIdx), _
         order1:=xlDescending, Header:=xlNo
         
          targetSheet.Range(arr(i) & nRowStartIdx & ":" & arr(i) & Lst_row).Value = thisSheet.Range(arr(0) & nRowStartIdx & ":" & arr(0) & Lst_row).Value
     Next
     
     '========================== 타겟 닫기 =======================
    thisSheet.Range("A1:D999999").ClearContents
          
     objWorkbook.Close SaveChanges:=True
     objExcel.Quit
     
 
     Set objWorkbook = Nothing
     Set objExcel = Nothing
    'Next
    
   
    
    '========================== 새시트를 만듬 ==========================
   ' Worksheets.Add Count:=1, after:=Sheets(Sheets.Count)
    
    
     
    'MsgBox Sheets.Count & " " & Sheets(1).Name & " " & Sheets(2).Name
    'copyTarget = Worksheets(Sheets(1).Name).Range(Cells(4, 4), Cells(5, 5))
    'pasteTarget = Worksheets(Sheets(1).Name).Range(Cells(10, 10), Cells(11, 11))
    'pasteTarget = Worksheets(Sheets(2).Name).Range(Cells(10, 10), Cells(11, 11))
    'Worksheets(Sheets(2).Name).Cells(1, 1).Value = "aa"
   
    
    'Worksheets("Sheet1").Range("D4").Copy Worksheets("Sheet1").Range("F1")
    'Do While Not IsEmpty(Cells(nRowIdx, nColumnIdx))
     '   Cells(nRowIdx, nColumnIdx).Select
      '  nRowIdx = nRowIdx + 1
       ' nIastIdx = nRowIdx - 1
    'Loop
    
    'MsgBox "nLastIdx " & nIastIdx
    
    '// 버블팝
    'Set DataList = CreateObject("System.Collections.ArrayList")
    'For i = 0 To Lst_col - nColumnStartIdx
        'DataList.Clear
        'For j = nRowStartIdx To Lst_row 'Lst_col - nColumnStartIdx
         '   Data = Worksheets(Sheets(1).Name).Range(arr(i) & j)
        '    DataList.Add Data
       ' Next
       'MsgBox UBound(arr)
       'For j = (DataList.Count - 2) To 0 Step -1
          'For k = 0 To j
            'If Len(DataList(k)) < Len(DataList(k + 1)) Then
            '    strTemp = DataList(k + 1)
           '     DataList(k + 1) = DataList(k)
          '      DataList(k) = strTemp
         '   End If
         ' Next
        'Next
    
    
      'For j = nRowStartIdx To Lst_row 'Lst_col - nColumnStartIdx
       '     Worksheets(Sheets(1).Name).Range(arr(i) & j).Value = DataList(j - nRowStartIdx)
     ' Next
    'Next
    'MsgBox "Lst_row " & Lst_row & "Lst_col " & Lst_col
End Sub

Function RelToAbs(RelPath As String) As String
    RelToAbs = ThisWorkbook.Path & "\" & RelPath
End Function

반응형
Comments