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