vba 用于创建工作表的 Excel 宏

Excel Macro to create sheets

提问by Harish

I have a Excel sheet with two columns and I need to create new sheets based on the values of the first column.ie

我有一个包含两列的 Excel 工作表，我需要根据第一列的值创建新工作表。

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

IN this case I need to create three sheets namely test1,test2 and test3

在这种情况下，我需要创建三张纸，即 test1、test2 和 test3

Sheet 1 should contain test1 field and its corresponding values.Similarly sheet 2 and 3 should contain corresponding values.

表 1 应包含 test1 字段及其相应的值。同样，表 2 和表 3 应包含相应的值。

Can anyone help me in writing an Excel Macro for this

任何人都可以帮助我为此编写 Excel 宏

回答by Pricey

I would recommend using a pivot table instead, depending on what you are trying to achieve.. if you need to do the above then I would try and do the below steps, I'll leave writing the code up to you, I have put a few functions below to help.

我建议改用数据透视表，具体取决于您要实现的目标。下面的一些功能可以提供帮助。

1. Select all used cells in A as a range.
2. Loop through the range and for each cell check if a sheet already exists with a name matching the cell value.
3. If the sheet does not exist then you can create it and then use the R1C1 reference styleto get the value from column B and paste it into the newly created sheet. Bare in mind a newly created sheet becomes the active sheet.
4. If the sheet exists then you can select the worksheet and do the same as in 3, making sure you paste into the next available cell below any already done.

1. 选择 A 中所有使用的单元格作为范围。
2. 循环遍历范围并为每个单元格检查是否已存在名称与单元格值匹配的工作表。
3. 如果工作表不存在，那么您可以创建它，然后使用R1C1 引用样式从 B 列中获取值并将其粘贴到新创建的工作表中。请记住，新创建的工作表将成为活动工作表。
4. 如果工作表存在，那么您可以选择工作表并执行与 3 中相同的操作，确保粘贴到任何已经完成的单元格下方的下一个可用单元格中。

I recommend using the macro recording to work out how to do the copy and paste etc.

我建议使用宏录制来确定如何进行复制和粘贴等。

Here is an example of adding and delete a work sheet:

以下是添加和删除工作表的示例：

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

Here is a sheetexists function that also makes use of the WorkbookIsOpen function shown below it. This can be used to help you see if a sheet you want to create already exists or not.

这是一个 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

I would recommend giving the values in range A a name that way you can iterate over them more easily so you can do this sort of thing:

我建议为范围 A 中的值命名，这样您就可以更轻松地迭代它们，以便您可以执行以下操作：

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

If you cant do that then you will need a function to check column A for a used range. like this one:

如果你不能这样做，那么你将需要一个函数来检查 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