무른모

제목처럼 수십만, 수백만행의 자료를 다룰려면 속도와 메모리때문에 힘든데 이것을 특정행만큼

잘라서 워크북을 만들어 주는 기능입니다.

Sub Split_File_By_Row()

Dim wrk As Workbook
Dim sht As Worksheet

Dim cols As Integer, dcnt As Integer, WorkbookCounter As Integer

Dim Rng2Cp As Range

Dim p As Long

Dim TempStr As String, strFullPath As String

strFullPath = FileNameNoExtensionFromPath(ThisWorkbook.FullName)

TempStr = Right(strFullPath, Len(strFullPath) – (InStrRev(strFullPath, “\”)))

dcnt = InputBox(“분할할 행 갯수를 입력하세요”)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set sht = ThisWorkbook.ActiveSheet

cols = sht.UsedRange.Columns.Count
WorkbookCounter = 1

Rows(1).Delete xlUp

For p = 1 To sht.UsedRange.Rows.Count Step dcnt

Set wrk = Workbooks.Add

Set Rng2Cp = sht.Range(sht.Cells(p, 1), sht.Cells(p + dcnt – 1, cols))
Rng2Cp.Copy wrk.Sheets(1).Range(“A1”)

wrk.SaveAs ThisWorkbook.Path & TempStr & “_” & WorkbookCounter
wrk.Close

WorkbookCounter = WorkbookCounter + 1

Set Rng2Cp = Nothing

Next p

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Set wrk = Nothing

End Sub

Function FileNameNoExtensionFromPath(strFullPath As String) As String

Dim intStartLoc As Integer
Dim intEndLoc As Integer
Dim intLength As Integer

intStartLoc = Len(strFullPath) – (Len(strFullPath) – InStrRev(strFullPath, “\”) – 1)
intEndLoc = Len(strFullPath) – (Len(strFullPath) – InStrRev(strFullPath, “.”))
intLength = intEndLoc – intStartLoc

FileNameNoExtensionFromPath = Mid(strFullPath, intStartLoc, intLength)

End Function

첨부 화일 :

오랜만에 쓸만한? 질문이 올라왔습니다. 여러 거래처를 관리하고 있는 엑셀 시트에서
바로 해당 거래선의 일부 이름으로 검색해서 바로 시트를 선택하고 싶다는 질문이네요.
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3735375

함수로서 기능을 잘 사용하시는 분은 함수로 사용하시고 저는 VBA가 편하기 때문에
이것을 도구로 사용해서 사용자 폼을 뛰어서 편리하게 시트를 검색, 선택하게 했습니다.

너무 간단해서 설명을 할 내용도 별로 없어 보입니다.

Option Explicit

우선 사용자 폼을 선택하면 LIST시트를 제외한 모든 시트를 목록에 뿌리는 루틴입니다.
사실 없어도 되는 기능입니다. 어짜피 검색 필드를 통해 검색 목록을 뿌리면 지워지는
항목이므로 … 그래도 이렇게 전체 시트를 보여줄 수 있다는 기능입니다.

Sub View_All_Sht_Name()

Dim sht As Worksheet

Dim sht_name As String

For Each sht In Worksheets
If sht.Name <> “LIST” Then
UserForm1.ListBox1.AddItem sht.Name

End If

Next sht

End Sub

이제 검색할 내용을 입력하고 입력 완료를 위해 오른쪽 화살표나 엔터키를 눌러주세요.
입력은 한글을 기본으로 입력되도록 설정해 두었습니다.

Private Sub TextBox1_Change()

Dim sht As Worksheet
Dim sht_name As String

UserForm1.ListBox1.Clear

For Each sht In Worksheets
If InStr(1, sht.Name, TextBox1.Text, 1) > 0 Then
If sht.Name <> “LIST” Then
UserForm1.ListBox1.AddItem sht.Name

End If
End If
Next sht

End Sub

검색된 시트를 클릭하면 바로 활성화 됩니다.

Private Sub ListBox1_Click()

Dim sht As Worksheet
Dim sel_sht As String

sel_sht = UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex)

For Each sht In Worksheets
If sht.Name = sel_sht Then
sht.Activate

End If
Next sht

End Sub
개발도구> 디자인모드에서 ActiveX 버튼 하나 만드시고 아래 매크로 연결시켜 주세요.
사용자 폼이 항상 시트 위에 윈도우로 떠 있도록 하는 것인데 검색할 때마다 폼을
띄우시려면 modalless 제거해 주세요

Private Sub CommandButton1_Click()

UserForm1.Show modalless

End Sub

Private Sub UserForm_Initialize()

Call View_All_Sht_Name

End Sub

첨부 화일 : 20160525-Sheet 이름으로 검색 선택