2010-03-29 147 views
1

我有一個Excel工作表有兩列,我需要基於第一column.ieExcel宏創建表

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

的在這種情況下,我需要即創建三個表的值來創建新表test1,test2和test3

工作表1應包含test1字段及其相應的值。類似地,工作表2和3應包含相應的值。

誰能幫我寫一個Excel宏這個

回答

4

,如果你需要做上述那麼我會嘗試,我會建議使用數據透視表來代替,這取決於你想達到什麼..做下面的步驟,我會留下代碼給你,我已經在下面的幾個功能來幫助。

  1. 選擇A中所有用過的單元作爲範圍。
  2. 遍歷範圍和每個單元格檢查表單是否已經存在,並且名稱與單元格值匹配。
  3. 如果圖紙不存在,則可以創建圖紙,然後使用R1C1 reference style從列B中獲取該值並將其粘貼到新創建的圖紙中。不要忘記新創建的工作表成爲活動工作表。
  4. 如果工作表存在,那麼您可以選擇工作表並執行與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