找出列中新文字的发生率,并插入分页符。

问题描述 投票:0回答:1

这个案例解释起来有点麻烦,但我可以试试。我想做一个子程序,在一列名为Buffer ID的单元格中找到第一次出现的文本(在本例中,第一个缓冲区名为0.1N-HCl),然后在该列中找到新的文本(值不=01.N HCl),并在第一个单元格和第二个单元格之间插入一个分页符,这样看起来就像这样(代码中不需要高亮)。图片示例 这是我目前的代码,但它并不能完全发挥作用。这段代码只能工作到 Range(FirstBuffer, FirstBuffer.End(xlDown)).Select

Sub PageSetup_PageBreaks_Buffers()
Dim WS As Worksheet
Dim BufferID As Range
Dim FirstBuffer As Range
Dim SecondBuffer As Range

Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")
Application.PrintCommunication = False

With WS
    ActiveSheet.ResetAllPageBreaks
    'Resets all page breaks
    ActiveWindow.View = xlPageBreakPreview
    'Shows page break preview
End With

Set BufferID = WS.Cells.Find(What:="Buffer ID", LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False)
    'Find column with Buffer ID header

With BufferID
Set FirstBuffer = BufferID.Offset(1)
'Find first buffer name under Buffer ID header
    With FirstBuffer
    Range(FirstBuffer, FirstBuffer.End(xlDown)).Select
    'Select column data below first buffer
        With Selection
            If FirstBuffer Is Nothing Then
            'Find first incidence of second buffer
            Set SecondBuffer = FirstBuffer.Offset(1)
                With SecondBuffer
                SecondBuffer.PageBreak = xlPageBreakManual
                End With
            End If
        End With
    End With
End With
End Sub

我卡住了,不知道如何完成执行。代码必须独立于实际的缓冲区ID名称,0.1N HCl和1X-PBS-pH7.4只是缓冲区名称的例子,可以在表里。有什么技巧可以完成这段代码,或者建议用另一种更精简的方式来执行这个函数?

excel vba excel-vba
1个回答
0
投票

你可以做这样的事情。

Sub PageSetup_PageBreaks_Buffers()
    Dim WS As Worksheet
    Dim BufferID As Range
    Dim c As Range, rngBuffers As Range, i As Long

    Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")


    WS.ResetAllPageBreaks 'Resets all page breaks

    'Find column with Buffer ID header
    Set BufferID = WS.Cells.Find(What:="Buffer ID", LookIn:=xlValues, LookAt:=xlWhole)

    If Not BufferID Is Nothing Then
        Application.PrintCommunication = False
        Set rngBuffers = WS.Range(BufferID, WS.Cells(WS.Rows.Count, BufferID.Column).End(xlUp)).Cells
        For i = 2 To rngBuffers.Cells.Count
            Set c = rngBuffers.Cells(i)
            If c.Value <> c.Offset(-1, 0).Value Then
                c.EntireRow.PageBreak = xlPageBreakManual
            End If
        Next i
        Application.PrintCommunication = True
        ActiveWindow.View = xlPageBreakPreview 'Shows page break preview
    End If

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.