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
반응형