Excel Macro для создания листов

Question

У меня есть лист Excel с двумя столбцами, и мне нужно создать новые листы на основе значений первого столбца .ie

A        B
test1    Value21
test1    Values22
test2    Value21
test2    Value32
test3    Values32

В этом случае мне нужно создать три листа, а именно test1, test2 и test3

Лист 1 должен содержать поле test1 и соответствующие ему значения. Аналогично, листы 2 и 3 должны содержать соответствующие значения.

Может ли кто-нибудь помочь мне в написании макроса Excel для этого

Answer 1

Я бы порекомендовал использовать вместо этого сводную таблицу, в зависимости от того, чего вы пытаетесь достичь ... если вам нужно выполнить вышеизложенное, то я постараюсь выполнить следующие шаги, я оставлю написание кода на ваше усмотрение, Я поставил несколько функций ниже, чтобы помочь.

1. Выберите все используемые ячейки в диапазоне A.
2. Переберите диапазон и для каждой ячейки проверьте, существует ли уже лист с именем, соответствующим значению ячейки.
3. Если лист не существует, вы можете его создать, а затем использовать стиль ссылки R1C1 *, чтобы получить значение из столбца B и вставить его во вновь созданный лист. Имейте ввиду, что вновь созданный лист становится активным.
4. Если лист существует, вы можете выбрать лист и сделать то же, что и в пункте 3, убедившись, что вы вставили в следующую доступную ячейку ниже любой уже готовой.

Я рекомендую использовать запись макросов, чтобы понять, как выполнять копирование, вставку и т. Д.

Вот пример добавления и удаления рабочего листа:

Dim sheetname
'not tested this, something similar to get the value, obviously you will need to loop through checking this sheet name
sheetname = Range("A:A").Cells(1,1).Value

If SheetExists(sheetname, ThisWorkbook.Name) Then
    'turn off alert to user before auto deleting a sheet so the function is not interrupted
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(sheetname).Delete
    Application.DisplayAlerts = True
End If

'Activating ThisWorkbook in case it is not
ThisWorkbook.Activate
Application.Sheets.Add

'added sheet becomes the active sheet, give the new sheet a name
ActiveSheet.Name = sheetname

Вот функция sheetexists, которая также использует функцию WorkbookIsOpen, показанную под ней. Это может быть использовано, чтобы помочь вам увидеть, если лист, который вы хотите создать, уже существует или нет.

    Function SheetExists(sname, Optional wbName As Variant) As Boolean
    '   check a worksheet exists in the active workbook
    '   or in a passed in optional workbook
        Dim X As Object

        On Error Resume Next
        If IsMissing(wbName) Then
            Set X = ActiveWorkbook.Sheets(sname)
        ElseIf WorkbookIsOpen(wbName) Then
            Set X = Workbooks(wbName).Sheets(sname)
        Else
            SheetExists = False
            Exit Function
        End If

        If Err = 0 Then SheetExists = True _
        Else SheetExists = False
    End Function

    Function WorkbookIsOpen(wbName) As Boolean
    '   check to see if a workbook is actually open
        Dim X As Workbook
        On Error Resume Next
        Set X = Workbooks(wbName)
        If Err = 0 Then WorkbookIsOpen = True _
        Else WorkbookIsOpen = False
    End Function

Я бы порекомендовал дать значениям в диапазоне A имя, чтобы вам было проще их перебирать, чтобы вы могли делать такие вещи:

For Each Cell In Range("ListOfNames")
...
Next

Если вы не можете этого сделать, вам понадобится функция, чтобы проверить столбец A на предмет использованного диапазона. как этот:

Function GetUsedRange(wbName As String, Optional wsName As Variant, Optional argFirstRow As Variant, Optional argLastCol As Variant) As Range
'this function uses the find method rather than the usedrange property because it is more reliable
'I have also added optional params for getting a more specific range
    Dim lastRow As Long
    Dim firstRow As Long
    Dim lastCol As Integer
    Dim firstCol As Integer
    Dim ws As Worksheet

    If Not IsMissing(wsName) Then
        If SheetExists(wsName, wbName) Then
            Set ws = Workbooks(wbName).Worksheets(wsName)
        Else
            Set ws = Workbooks(wbName).ActiveSheet
        End If
    Else
        Set ws = Workbooks(wbName).ActiveSheet
    End If

    If IsMissing(argFirstRow) Then
        ' Find the FIRST real row
        firstRow = ws.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
    Else
        firstRow = argFirstRow
    End If

    ' Find the FIRST real column
    firstCol = ws.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
    ' Find the LAST real row
    lastRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

    If IsMissing(argLastCol) Then
        ' Find the LAST real column
        lastCol = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    Else
        lastCol = argLastCol
    End If

    'return the ACTUAL Used Range as identified by the variables above
    Set GetUsedRange = ws.Range(ws.Cells(firstRow, firstCol), ws.Cells(lastRow, lastCol))
End Function