Excel宏创建表

我有一个Excel工作表有两列，我需要基于第一column.ieExcel宏创建表

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

的在这种情况下，我需要即创建三个表的值来创建新表test1，test2和test3

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

谁能帮我写一个Excel宏这个

来源

2010-03-29 Harish

，如果你需要做上述那么我会尝试，我会建议使用数据透视表来代替，这取决于你想达到什么..做下面的步骤，我会留下代码给你，我已经在下面的几个功能来帮助。

选择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

我会建议更容易给值范围内的一个名字这样你可以在它们之间迭代所以你可以做这样的事情：

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

来源

2010-03-30 12:28:42 Pricey

Excel宏创建表

回答

相关问题