Excel VBA를 사용하여 시트를 만들고 특정 열의 고유 항목을 기반으로 데이터를 이동하십시오.

Question

프로그래밍에 익숙하지만 VBA 또는 Excel 객체 모델에는 익숙하지 않습니다. 나는 그것을 극도로 좌절시키는 것으로 생각하고있다.

내가 가진 것은 열 제목이있는 데이터 한 장입니다. 데이터의 유형에 따라 다양한 표제가 있으므로 항상 같은 장소에 있지 않은 특정 열 (모든 시트에서)을 찾아야합니다 (그래서 하드 코딩 할 수는 없습니다).

내가 각 성을위한 시트, 해당 이름을 가진 바람직 제목을 만든 다음 이름으로, 각각의 특정 시트에 원래의 시트에서 모든 행을 복사 할

내가 지금까지 무엇을 가지고 :

Cells.find(What:="Last_Name", After:=ActiveCell, LookIn:=xlFormulas, _ 
     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
     MatchCase:=False, SearchFormat:=False).Activate 

이름이있는 열을 찾으려면. 그때 나는 열 정렬 할 수 있습니다 (전혀 필요하지 않지만 수동으로 복사 부분을 수행 할 때 도움이됩니다.)

ActiveCell.Sort key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes 

그러나 그 후 나는 목록에 독특한 아이템을 얻을 수있는 방법을 찾기 위해 고군분투 또는 배열 또는 무언가.

나는 그래서 주요 부분이 시트에 같은 이름의 시트에 시트 및 복사 적절한 행을 만드는 고유 한 이름을 반복하는 방법을 찾는 것입니다

Set WS = Sheets.Add 
WS.name = "string name goes here" 

와 시트를 만드는 방법을 알고 행에서와 같이.

VBA 또는 Excel과 인터페이스하는 다른 방법 (.Net 어떻게 든?)을 배우는 데 도움이되는 정보는 매우 감사하겠습니다.

Answer 1

이것은 당신이

Sub MakeLastNameSheets() 

    Dim rLNColumn As Range 
    Dim rCell As Range 
    Dim sh As Worksheet 
    Dim shDest As Worksheet 
    Dim rNext As Range 

    Const sLNHEADER As String = "Last_Name" 

    Set sh = ThisWorkbook.Sheets("Sheet1") 
    Set rLNColumn = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole) 

    'Make sure you found something 
    If Not rLNColumn Is Nothing Then 
     'Go through each cell in the column 
     For Each rCell In Intersect(rLNColumn.EntireColumn, sh.UsedRange).Cells 
      'skip the header and empty cells 
      If Not IsEmpty(rCell.Value) And rCell.Address <> rLNColumn.Address Then 
       'see if a sheet already exists 
       On Error Resume Next 
        Set shDest = sh.Parent.Sheets(rCell.Value) 
       On Error GoTo 0 

       'if it doesn't exist, make it 
       If shDest Is Nothing Then 
        Set shDest = sh.Parent.Worksheets.Add 
        shDest.Name = rCell.Value 
       End If 

       'Find the next available row 
       Set rNext = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Offset(1, 0) 

       'Copy and paste 
       Intersect(rCell.EntireRow, sh.UsedRange).Copy rNext 

       'reset the destination sheet 
       Set shDest = Nothing 
      End If 
     Next rCell 
    End If 

End Sub 

당신은 목록에있는 모든 성을위한 하나의 시트 겁니다 가까이해야합니다. 고유 한 성 (성)이 1,000 개있는 경우 Excel에서 오류가 발생할 수 있습니다. 시트는 사용 가능한 메모리로 제한됩니다. 헤더 행을 복사하지는 않지만 충분히 쉽습니다. 그리고 그것은 불법 시트 이름 문자를 검사하지 않습니다. 그래서 당신이 펑키 한 성을 가지고 있다면 비 알파를 제거하고 싶을 것입니다.