2

我需要一些有关 Excel 2010 中 VBA 的帮助来编写宏。

我需要知道如何根据一列中的条件复制特定范围的行，并将包含该指定条件的每一行（整行，所有其他字段）粘贴到其相应的工作表中（下面将详细解释）。困难的部分是那些“目标”表可能已经有一些数据需要留在那里而不是被删除。那么，我怎样才能编写一个宏来执行我刚才描述的操作，但是当它开始粘贴时，它会找到第一个空行来开始粘贴？

我有一本大约有 5 张纸的工作簿。第一个工作表是ALL包含所有数据的工作表。接下来的 4 张纸被命名为Tree、Graffiti和。所有 5 张工作表中的所有字段都相同。在每张表中，都有一个名为的字段，它是这四种服务之一（、或）。LightPotholeType Of Servicetreegraffitilightpothole

我需要做的是过滤ALL这 4 个服务中的每一个的工作表（一次一个），选择包含指定服务的所有字段和所有行，将其全部复制，然后将其粘贴到其单独的工作表中。这些单独的工作表可能包含一些数据，因此粘贴需要找到第一个空行，并将其粘贴到那里。将工作表与 ALL 工作表中复制的行原样连接。我需要宏来一起完成所有 4 个服务过滤器/粘贴。

4

1 回答 1

1

您可以通过录制宏并查看它来了解所有内容。还有一个额外的知识，而不是说“A1：G3”，你可以使用 Range( Cells(x,y), Cells(x,y) ) 并做例如

Range( Cells(1,1), Cells(1,3).Select
ActiveSelection.Copy ' or .Cut

转到 Excel 选项并在常规选项卡上选择使用 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
于 2012-06-08T01:52:11.677 回答