Excel 宏创建工作表

Question

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

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

在这种情况下，我需要创建三个工作表，即 test1、test2 和 test3

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

谁能帮我为此编写一个 Excel 宏

Answer 1

我建议您使用数据透视表，具体取决于您要实现的目标。如果您需要执行上述操作，那么我将尝试执行以下步骤，我将把代码留给您，我已经把下面的一些功能可以提供帮助。

选择 A 中所有使用的单元格作为范围。

循环遍历范围并为每个单元格检查是否已经存在名称与单元格值匹配的工作表。

如果工作表不存在，那么您可以创建它，然后使用 R1C1 reference style从 B 列获取值并将其粘贴到新创建的工作表中。请记住，新创建的工作表将成为事件工作表。

如果工作表存在，那么您可以选择工作表并执行与 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