행 값에 해당하는 시트 생성 (중복 값 있음)

Question

사용자가 시트 번호, 테스트 섹션 및 재료를 수동으로 입력하는 기본 워크 시트 (Install_Input)가 있습니다.

(아래 : 범위 A1 : Install_Input의 WS의 그림 C8)

시트 # | TestSection | 재질

..... 1 ..... | .......... A .......... | .STEEL |

..... 2 ..... | .......... B .......... | .PLASTIC. |

..... 3 ..... | .......... C .......... | .STEEL |

..... 5 ..... | .......... G .......... | .STEEL |

..... 2 ..... | .......... F .......... | .PLASTIC. |

..... 2 ..... | .......... A .......... | .STEEL |

..... 5 ..... | .......... D .......... | .PLASTIC. |

현재 통합 문서에서 Install_Input에 입력 된 시트 번호에 해당하는 시트를 생성하려고합니다. 내가 만든 코드는 MyRange의 각 값에 대해 새로운 시트를 생성합니다. 이미 존재하는 시트 생성을 코드에서 건너 뛰고 싶습니다. "On Error Resume Next"및 "On Error GoTo 0"명령을 사용하여이 문제를 해결하려고 시도했지만 이미 존재하는 시트를 보완하기 위해 이름없는 시트를 생성했습니다.

Sub Consolidate_Sheets() 
    Dim MyCell As Range 
    Dim MyRange As Range 
    Dim ws As Worksheet 

    Set MyRange = Sheets("Install_Input").Range("A2") 
    Set MyRange = Range(MyRange, MyRange.End(xlDown)) 


    For Each MyCell In MyRange 
     If Sheets(Sheets.Count).Name <> MyCell.Value Then 
      'On Error Resume Next 
      Sheets.Add After:=Sheets(Sheets.Count) 
      Sheets(Sheets.Count).Name = MyCell.Value 
      'On Error GoTo 0 
     End If 
    Next MyCell 
End Sub 

Answer 1

다음과 같은 두 가지 기능을 사용할 수 있습니다

Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet 
     If wb Is Nothing Then 
      Set wb = ThisWorkbook 
     End If 

     If Not sheetExists(name, wb) Then 
      wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name 
     End If 

     Set getSheetWithDefault = wb.Sheets(name) 
    End Function 

    Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean 
     Dim sheet As Excel.Worksheet 

     If wb Is Nothing Then 
      Set wb = ThisWorkbook 
     End If 

     sheetExists = False 
     For Each sheet In wb.Worksheets 
      If sheet.name = name Then 
       sheetExists = True 
       Exit Function 
      End If 
     Next sheet 
    End Function 

을 코드에서 사용하려면

Sub Consolidate_Sheets() 
     Dim MyCell As Range 
     Dim MyRange As Range 
     Dim ws As Worksheet 

     Set MyRange = Sheets("Install_Input").Range("A2") 
     Set MyRange = Range(MyRange, MyRange.End(xlDown)) 

     For Each MyCell In MyRange 
      If Sheets(Sheets.Count).Name <> MyCell.Value Then 
       'On Error Resume Next 
       set ws = getSheetWithDefault(MyCell.Value) 
       'On Error GoTo 0 
      End If 
     Next MyCell 
    End Sub 

Answer 2

당신은 기존의 모든 시트를 반복하고 전달 된 값을 각 시트의 이름을 비교 this SO answer에 설명 된 것과 같은 CheckSheet 기능을 구현할 수있다.