Sub DeleteEmptyRows()
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub
Sub DeleteEmptyHeaders()
'Delete the row if column A is empty
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 2 Step -1 'Exclude the first row from the range
'If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
If Application.CountA(Cells(r, 1)) = 0 Then Rows(r).Delete
Next r
removeColor
End Sub
Sub sortJefOS()
'
' sortJefOS Macro
'
' Hardcoded for only one worksheet of Jimmy's log(Jef-X: Magic&OS)
Dim srt As Sort
Set srt = ActiveSheet.Sort
With srt.SortFields
.Clear
.Add Key:=Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Number of sockets
.Add Key:=Columns("I"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Base
.Add Key:=Columns("A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Account
.Add Key:=Columns("B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 'Character
End With
'With ActiveWorkbook.Worksheets("Magic&OS").Sort
With srt
.SetRange Cells
.Header = xlYes 'My data has headers
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
DeleteEmptyHeaders
End Sub
Sub removeColor()
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Sub stripTag()
'Cells.Select
'Dim rngSelected As Range
'Set rngSelected = New Cells.Select
'Call stripHtml(rngSelected) 'html제거
Cells.Hyperlinks.Delete 'hyperlink 제거
ActiveSheet.Pictures.Delete '그림 제거
End Sub
Function stripHtml(cell As Range) As String
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
Dim sInput As String
Dim sOut As String
sInput = cell.Text
sInput = Replace(sInput, "\x0D\x0A", Chr(10))
sInput = Replace(sInput, "\x00", Chr(10))
'replace HTML breaks and end of paragraphs with line breaks
sInput = Replace(sInput, "</P>", Chr(10) & Chr(10))
sInput = Replace(sInput, "<BR>", Chr(10))
'replace bullets with dashes
sInput = Replace(sInput, "<li>", "-")
'add back all of the special characters
sInput = Replace(sInput, "–", "?")
sInput = Replace(sInput, "—", "?")
sInput = Replace(sInput, "¡", "¡")
sInput = Replace(sInput, "¿", "¿")
sInput = Replace(sInput, """, "")
sInput = Replace(sInput, "“", "“")
sInput = Replace(sInput, "”", "”")
sInput = Replace(sInput, "", "‘")
sInput = Replace(sInput, "‘", "‘")
sInput = Replace(sInput, "’", "’")
sInput = Replace(sInput, "«", "≪")
sInput = Replace(sInput, "»", "≫")
sInput = Replace(sInput, " ", " ")
sInput = Replace(sInput, "&", "&")
sInput = Replace(sInput, "¢", "¢")
sInput = Replace(sInput, "©", "ⓒ")
sInput = Replace(sInput, "÷", "÷")
sInput = Replace(sInput, ">", ">")
sInput = Replace(sInput, "<", "<")
sInput = Replace(sInput, "µ", "μ")
sInput = Replace(sInput, "·", "·")
sInput = Replace(sInput, "¶", "¶")
sInput = Replace(sInput, "±", "±")
sInput = Replace(sInput, "€", "€")
sInput = Replace(sInput, "£", "£")
sInput = Replace(sInput, "®", "®")
sInput = Replace(sInput, "§", "§")
sInput = Replace(sInput, "™", "™")
sInput = Replace(sInput, "¥", "¥")
sInput = Replace(sInput, "á", "a")
sInput = Replace(sInput, "Á", "A")
sInput = Replace(sInput, "à", "a")
sInput = Replace(sInput, "À", "A")
sInput = Replace(sInput, "â", "a")
sInput = Replace(sInput, "Â", "A")
sInput = Replace(sInput, "å", "a")
sInput = Replace(sInput, "Å", "A")
sInput = Replace(sInput, "ã", "a")
sInput = Replace(sInput, "Ã", "A")
sInput = Replace(sInput, "ä", "a")
sInput = Replace(sInput, "Ä", "A")
sInput = Replace(sInput, "æ", "æ")
sInput = Replace(sInput, "Æ", "Æ")
sInput = Replace(sInput, "ç", "c")
sInput = Replace(sInput, "Ç", "C")
sInput = Replace(sInput, "é", "e")
sInput = Replace(sInput, "É", "E")
sInput = Replace(sInput, "è", "e")
sInput = Replace(sInput, "È", "E")
sInput = Replace(sInput, "ê", "e")
sInput = Replace(sInput, "Ê", "E")
sInput = Replace(sInput, "ë", "e")
sInput = Replace(sInput, "Ë", "E")
sInput = Replace(sInput, "í", "i")
sInput = Replace(sInput, "Í", "I")
sInput = Replace(sInput, "ì", "i")
sInput = Replace(sInput, "Ì", "I")
sInput = Replace(sInput, "î", "i")
sInput = Replace(sInput, "Î", "I")
sInput = Replace(sInput, "ï", "i")
sInput = Replace(sInput, "Ï", "I")
sInput = Replace(sInput, "ñ", "n")
sInput = Replace(sInput, "Ñ", "N")
sInput = Replace(sInput, "ó", "o")
sInput = Replace(sInput, "Ó", "O")
sInput = Replace(sInput, "ò", "o")
sInput = Replace(sInput, "Ò", "O")
sInput = Replace(sInput, "ô", "o")
sInput = Replace(sInput, "Ô", "O")
sInput = Replace(sInput, "ø", "ø")
sInput = Replace(sInput, "Ø", "Ø")
sInput = Replace(sInput, "õ", "o")
sInput = Replace(sInput, "Õ", "O")
sInput = Replace(sInput, "ö", "o")
sInput = Replace(sInput, "Ö", "O")
sInput = Replace(sInput, "ß", "ß")
sInput = Replace(sInput, "ú", "u")
sInput = Replace(sInput, "Ú", "U")
sInput = Replace(sInput, "ù", "u")
sInput = Replace(sInput, "Ù", "U")
sInput = Replace(sInput, "û", "u")
sInput = Replace(sInput, "Û", "U")
sInput = Replace(sInput, "ü", "u")
sInput = Replace(sInput, "Ü", "U")
sInput = Replace(sInput, "ÿ", "y")
sInput = Replace(sInput, "", "´")
sInput = Replace(sInput, "", "`")
'replace all the remaining HTML Tags
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
End With
sOut = RegEx.Replace(sInput, "")
stripHtml = sOut
Set RegEx = Nothing
End Function
'SI개발 > VBA' 카테고리의 다른 글
[VBA] Format Yahoo Fantasy Players List (0) | 2023.02.03 |
---|---|
[VBA]디렉토리 안의 파일 목록 구하기2 (0) | 2022.12.11 |
[VBA] 차트 범례 추가, 삭제 (0) | 2021.03.27 |
[VBA]디렉토리 안의 파일 목록 구하기 (0) | 2017.10.28 |
[VBA]Excel. DB칼럼명을 Camel, pascal로 변환 (0) | 2016.03.26 |