vba - 열의 새 시트, X 열의 X가 새 시트

Question

통합 문서의 각 열에 대해 새 시트를 생성하려는 경우 열 A를 붙여 넣습니다. (완료, 아래 붙여 넣기). 다음 단계는 값이 열 'X'에 있으면 A 열의 값을 붙여 넣는 것입니다.

Name | Email | Course 101 | Course 203 | 
John | john @|  X  |  X  | 
Jane |Jane@ |  X  |   | 

결과는 시트 생성 코드에서 '범위'기능으로 제어되는 두 개의 시트 (코스 101, 코스 203)가됩니다.

파트 저는 Course 101과 Course 203 시트에 John의 이름을 붙여 넣는 방법과 Course 101 시트에만 Jane을 붙여 넣는 방법입니다.

여기

Sub AddSheets() 
Dim cell As Excel.Range 
Dim wsWithSheetNames As Excel.Worksheet 
Dim wbToAddSheetsTo As Excel.Workbook 

    Set wsWithSheetNames = ActiveSheet 
Set wbToAddSheetsTo = ActiveWorkbook 
For Each cell In wsWithSheetNames.Range("A1:d1")  
    With wbToAddSheetsTo 
     .Sheets.Add after:=.Sheets(.Sheets.Count) 
     On Error Resume Next 
     ActiveSheet.Name = cell.Value 
     If Err.Number = 1004 Then 
      Debug.Print cell.Value & " already used as a sheet name" 
     End If 
     On Error GoTo 0 
     End With 
    Next cell 
    End Sub 

Answer 1

은 위의 코드는 워크 시트를 삽입 할 작동하지만 그 이후로 아무것도하지 않는다 (내가 :) 여기에 찾을 생각) 시트 생성을 위해 작동하는 코드입니다. 위의 스크립트를 기반으로 필자는 원하는 것을 수행하지만 변수와 용어를 약간 이해하기 쉽도록 비슷한 것을 작성했습니다. 아래 붙여 넣은 코드는 기본 워크 시트 이름을 입력하거나 기본 워크 시트의 이름을 "Main"으로 설정해야합니다.

이 코드는 프로세스를 2 개의 블록으로 나누기 때문에 이해하기 쉬워야합니다.

Sub FillCourseWorksheets() 
    Dim wb As Workbook, cws As Worksheet, ws As Worksheet, found As Boolean 
    Dim crw As Long, rw As Long, col As Integer, wsName As String 
    Dim CheckString As String, student As String, lastRow As Long 
    Dim lastCol As Integer, courseName As String, resultRow As Long 

    'this code depends on the main sheet to have the headers in row 1 

    '---------------------------------------------------------- 
    wsName = "Main" 'set this to the name of your main worksheet 
    '---------------------------------------------------------- 


    'set up 
    Set wb = ThisWorkbook 
    'if you get an error here set the sheet name to main 
    Set cws = wb.Worksheets(wsName) 
    'use the .end to find the last column and row similar to CTRL + Right/Down 
    lastRow = cws.Range("A1").End(xlDown).Row 
    lastCol = cws.Range("A1").End(xlToRight).Column 

    'go through each column and add a worksheet if needed 

    For col = 3 To lastCol 
    CheckString = cws.Cells(1, col).Value 
    'check if the worksheet already exists 
    found = False 
    For Each ws In wb.Worksheets 
     If ws.Name = CheckString Then 
     found = True 
     Exit For 
     End If 
    Next ws 
    If found = False Then 'didnt find the sheet. Add it to the workbook 
     Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count)) 'add the worksheet 
     ws.Name = CheckString 'name it 
     ws.Range("A1").Value = "Name" 
     cws.Activate 'activate the main page after insert 
    End If 
    Next col 

    'all worksheets added go through columns again and add data to each worksheet 
    For col = 3 To lastCol 
    courseName = cws.Cells(1, col).Value 
    Set ws = wb.Worksheets(courseName) 'identify the worksheet to use 
    For checkrow = 2 To lastRow 
     If cws.Cells(checkrow, col).Value <> "" Then 
     student = cws.Range("A" & checkrow).Value 
     'set the resultrow and check if there is no data 
     If ws.Range("A2").Value = "" Then 
      resultRow = 2 
     Else 
      resultRow = ws.Range("A1").End(xlDown).Row + 1 
     End If 
     ws.Range("A" & resultRow).Value = student 'print out the student 
     End If 
    Next checkrow 
    Next col 


    MsgBox "done" 



End Sub 

실행하기 전에 통합 문서를 저장하고 문제가 있으면 알려주십시오.