你可以通過錄制宏觀來了解一切。 有知識的一個額外的和平,這是不是說 「A1:G3」 可以使用範圍(單元格(X,Y),電池(X,Y)) 和例如
Range(Cells(1,1), Cells(1,3).Select
ActiveSelection.Copy ' or .Cut
做轉到Excel選項並在常規選項卡上選擇USE R1C1樣式。 excel也顯示列上的數字。
空細胞被
IsEmpty(Cells(3,9))
發現打開現有工作表使用
Sheets("All").Select
所以
dim currentService
currentService = Cells(i, 3) ' current row, 13'th column
Sheets(currentService).Select
所以它是這樣的: 要麼找到過濾函數然後通過moveDown遍歷單元格。
可能是最容易將 通過服務 排序查找迭代上線,直到達到別的 (這不是空的) 複製整個範圍內爲每個服務 選擇正確的書開始,每個服務的結束行該服務, 找到該服務表(空行通過在每一行讀一個單元格,或者如果你想查詢一些細胞:
Function hasRowContent (rownum as Integer) as Boolean
Dim rowContentCheck
rowContentCheck = Cells(rownnum, 1) & Cells(rownum, 3) & Cells(rownnum, 7)
hasRowContent = rowContentCheck <> ""
Return
End Function
計數空的行數。 你沒有內容遇到的每一行增加emptyRows計數器
emptyRows = emptyRows + 1
你的內容遇到的每一行,設置emptyRows回零,並從這裏開始計數。
If emptyRows > emptyRowsToStopAt
rowInServiceSheet = currentRow
的代碼開始......
dim emptyRowsToStop
dim emptyRows
For currentRow = 1 To 1000
編輯:
所有代碼都在我的第一個答案
這裏解釋雲:
Public Function SheetExists(sheetName As String) As Boolean
' Sheet! It Exists
Dim wrkSheet As Worksheet
SheetExists = False
For Each wrkSheet In ThisWorkbook.Worksheets
If wrkSheet.Name = sheetName Then
SheetExists = True
Exit For
End If
Next
End Function
Sub createMissingServicePages()
' start on first cell in ALL
Sheets("all").Select
Row1.Select
Row1.Copy
Dim serviceTypes
serviceTypes = Array("Tree", "Graffiti", "Light", "Pothole")
Dim serviceTypeName As String
For Each serviceType In serviceTypes
serviceTypeName = serviceType
If Not SheetExists(serviceTypeName) Then
' create a new sheet - at the end of the Sheets list
Sheets.Add After:=Sheets(Sheets.Count) ' after 8
' and name it
Sheets(Sheets.Count).Name = serviceTypeName ' by now its 9
' select it and copy first row to it
'.. copy header row
Sheets("All").Select
Rows(1).Select
Rows(1).Copy
' .. paste in target sheet
Sheets(Sheets.Count).Select
Cells(1, 1).Select
ActiveCell.PasteSpecial xlPasteAll
End If
Next
End Sub
Sub updateServicePages()
' if you wish to see the column numbers rather than letters
' change settings in Options/GENERAL tab to View R1C1 style
Call createMissingServicePages
' start on first cell in ALL
Sheets("all").Select
Cells(1, 1).Select
' We'll need this later:
' count the columns
Dim columnsCount As Integer
For Each aCell In Rows(1).Cells
If IsEmpty(aCell) Then
columnsCount = aCell.Cells.Column
Exit For
End If
Next
' get TypeOfService column number
Dim serviceTypeHeaderText As String
Dim serviceTypeColumnnum As Integer
serviceTypeHeaderText = "type of service" ' ignoring case...
Cells.Find(What:=serviceTypeHeaderText, _
After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
serviceTypeColumnnum = ActiveCell.Column
' sort the whole range
Cells.Select ' first select the whole range
' unremark next line of code if you want to format the data nicely...
'Cells.EntireColumn.AutoFit ' if we are already at it
Selection.Sort Key1:=Cells(1, serviceTypeColumnnum), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' now move the data for each typeofService
Dim serviceTypes
Dim serviceTypeName As String
serviceTypes = Array("Tree", "Graffiti", "Light", "Pothole")
Dim rangeStart As Integer
Dim rangeEnd As Integer
For Each serviceType In serviceTypes
' we reset for each serviceType
Sheets("all").Select
Cells(1, 1).Select
rangeStart = 0
rangeEnd = 0
serviceTypeName = serviceType
' .. find range start and end
For Each aRow In Rows
If aRow.Cells(serviceTypeColumnnum) = serviceTypeName Then
If rangeStart = 0 Then rangeStart = aRow.Cells.Row
Else
If rangeStart <> 0 Then ' we just exited the range
rangeEnd = aRow.Cells.Row - 1
Exit For ' done with this serviceType range
Else ' didn't reach our range yet
End If
End If
Next ' row
' No 'continue' in VBA... and don't want to use a GOTO
' If rangeStart = 0 Or rangeEnd = 0 Then 'continue for
If rangeStart <> 0 And rangeEnd <> 0 Then
' .. now copy serviceType to correct sheet
Dim servicetypeRange As Range
Set servicetypeRange = Range(Cells(rangeStart, 1), Cells(rangeEnd, columnsCount))
servicetypeRange.Select
servicetypeRange.Copy
' find empty row in target sheet
Sheets(serviceTypeName).Select
Dim emptyrowNum As Integer
Dim emptyrowCount As Integer
Dim emptyrowMax As Integer
Dim emptyrowMargin
emptyrowMax = 5 ' set this to 1 if there are no spaces in the data
emptyrowMargin = 0 ' change this if you want an empty row between last data and new data
For Each aRow In Rows
If IsEmpty(aRow.Cells(1)) Then ' you could check over a few cells by: & isEmpty(aRow.Cells(2)) etc.
emptyrowCount = emptyrowCount + 1
If emptyrowCount > emptyrowMax Then
emptyrowNum = aRow.Row - emptyrowCount ' last empty row
If emptyrowNum < 1 Then emptyrowNum = 1
emptyrowNum = emptyrowNum + emptyrowMargin
Exit For ' we found empty row
End If
End If
Next
Cells(emptyrowNum, 1).Select
ActiveCell.PasteSpecial xlPasteAll ' ,skipBlanks if needed
End If
Next ' serviceType
Sheets("All").Select
Cells(1, 1).Select
MsgBox "Done!"
End Sub