VBA 메크로 모음2

셀 데이터 분할 및 합치기

 

 Dim split_data() As String
 Dim Data As Variant
 
 split_data = Split(Sheet1.Range("C1").Value, ",")
 
 	'// 각 요소를 하나씩 출력
     For Each Data In split_data
         msgbox Data
     Next
 
 '// 분할된 요소 다시 합치기
 msgbox Join(split_data, ",")

셀 데이터 초기화

 

 Sheet1.Range("B1:B15,f1:f15").ClearContents

웹 페이지 정보 수집

 

 Dim web_element As Object
 Set MyBrowser = CreateObject("InternetExplorer.Application")
 With MyBrowser
     .Navigate [웹사이트 URL]
 	'// wait browser는 다른 sub로 정의하기 
 	 Wait_Browser MyBrowser
        Application.Wait (Now + TimeValue("0:0:3")) '// 3초간 열릴 때까지 대기
 	    
 		'// HTML 상위 요소 정의
 		Set HTMLDoc = .Document
 		
 	'// 요소 추출
 	On Error Resume Next
     For Each web_element In HTMLDoc.getElementsByClassName("test-keyword")(1).getElementsByTagName("a")(0)
         msgbox web_element.getAttribute("attbute-date")
     On Error Resume Next
     Next
 
 End With
 MyBrowser.Quit
 Set MyBrowser = Nothing
 
 Sub Wait_Browser(Browser As InternetExplorer, Optional t As Integer = 1)
 	While Browser.Busy Or Browser.ReadyState <> 4
 	DoEvents
 	Wend
 	
 	Application.Wait DateAdd("s", t, Now)
 End Sub

특정 단어가 포함된 행만 보이기

 

 Dim keyword As String
 Dim keyword_len As Integer
 Dim keyword1 As String
 Dim keyword2 As String
 
 keyword = Sheet1.Cells(3, "C")
 
 '// 아래 길이 구하는 코드는 무시하고 keyword1과 keyword2에 필터링하려는 텍스트만 삽입한다
 '// ex) keyword1= *미역국*
 keyword_len = Len(keyword)
 keyword1 = "*" + Left(keyword, (keyword_len / 2)) + "*"
 
 If Int(((keyword_len / 2) - 1)) <> 0 Then
 keyword2 = "*" + Left(keyword, (keyword_len / 2) - 1) + "*"
 Else
 keyword2 = "*" + keyword + "*"
 End If
 
 '// 키워드가 포함된 셀만 보여줌
 Sheet1.Cells(9, "A").AutoFilter 2, Array(keyword1, keyword2), xlFilterValues
 Sheet2.Cells(2, "G").AutoFilter 6, Array(keyword1, keyword2), xlFilterValues

필터링 후 보이는 셀들만 저장한 뒤 순서 번호 재배열

 

 Dim Workrng As Object
 Dim xIndex As Integer
 Dim Rng As Object 
 '// 보이는 셀들만 필터
 Set Workrng = Sheet2.Range("A1:A15").Columns(1).SpecialCells(xlCellTypeVisible)
 
 '// 필터링 하느라 뒤엉킨 순서 번호 재배열
 '// 단점은 필터 해제 후 숫자를 다시 맞춰줘야함
 xIndex = 1
 	For Each Rng In Workrng
 		Rng.Value = xIndex
 		xIndex = xIndex + 1
 	Next
 
 '// Sheet1.Range("A9:Q44").Sort Key1:=Sheet1.Range("H9"), Order1:=xlAscending, Key2:=Sheet1.Range("M9"), Order2:=xlDescending

파일 저장

 

 Dim TF As Object
 Dim TFT As Object
 Set TF = CreateObject("scripting.filesystemobject")
 Set TFT = TF.Createtextfile(ThisWorkbook.Path & "\txt\" & title & ".txt")
 
 '// 마지막 행 번호 구하기
 '// lastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
 
 TFT.WriteLine "data1" & " " & "data2"
 TFT.WriteLine "data3" & " " & "data4"
 
 TFT.Close
 Set TF = Nothing
 Set TFT = Nothing