Excelmacros创build工作表

我有一个两列的Excel工作表，我需要创build基于第一个column.ie的值的新工作表

AB test1 Value21 test1 Values22 test2 Value21 test2 Value32 test3 Values32 

在这种情况下，我需要创build三个表，即test1，test2和test3

工作表1应包含test1字段及其相应的值。类似地，工作表2和3应包含相应的值。

任何人都可以帮我写一个Excelmacros为此

Answer 1

我build议使用一个数据透视表，而不是取决于你想要达到什么目标。如果你需要做以上的事情，那么我会尝试做下面的步骤，我会留下写代码给你，我已经把下面有几个function可以帮助。

1. selectA中所有使用的单元格作为范围。
2. 遍历范围并为每个单元检查一个表是否已经存在一个与单元格值匹配的名称。
3. 如果工作表不存在，则可以创build它，然后使用R1C1参考样式获取B列中的值并将其粘贴到新创build的工作表中。 不要忘记新创build的工作表成为活动工作表。
4. 如果工作表存在，那么您可以select工作表，并按照3中的方式执行，确保您粘贴到任何已经完成的下一个可用单元格中。

我build议使用macroslogging来制定如何进行复制和粘贴等。

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

 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函数。 这可以用来帮助您查看您要创build的工作表是否已经存在。

  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 

我build议给范围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