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

Excel宏以创建工作表

1 个答案: