Question

我编写了代码（如下所示），在B列中找到单词Total。然后将选择内容导出为PDF。然后，Total替换为Done。

我正在尝试找到一种方法来重复此代码，直到B列中不再有Total。

Columns("B:B").Select
Selection.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(-1, -1).Activate

    ActiveSheet.Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(, 15).Select
    Selection.Offset(, 1).Select


    Dim rng As Range
    With ActiveSheet
    Set rng = Selection
    .PageSetup.PrintArea = rng.Address
    .PageSetup.Orientation = xlLandscape
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = 999
    .PageSetup.PrintTitleRows = "$1:$4"
    .PageSetup.LeftMargin = Application.InchesToPoints(0.45)
    .PageSetup.RightMargin = Application.InchesToPoints(0.2)
    .PageSetup.TopMargin = Application.InchesToPoints(0.25)
    .PageSetup.BottomMargin = Application.InchesToPoints(0.25)
    .PageSetup.HeaderMargin = Application.InchesToPoints(0.3)
    .PageSetup.FooterMargin = Application.InchesToPoints(0.3)
    .PageSetup.PaperSize = xlPaperA4
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = False


    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="C:Users\kgs-aizat.kassim\Desktop\" & ActiveCell.Offset(0, -1).Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    End With

Columns("B:B").Select

Selection.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    ActiveCell.Value = "Done"

 End Sub

Answer 1

这里有一些代码可以在列B中搜索SearchItem的所有条目。您需要在此处包含对PDF处理的调用。

顺便说一下，如果将单元格内容更改为“完成”作为查看是否没有更多单元格要处理的方法，则不需要这样做。如果你注释掉这一行：

rPtr.Value = ReplaceItem

代码仍会只找到一次单元格。

Option Explicit

Sub test()

Dim rData As Range
Set rData = Sheets(1).Range("B:B")
Call ReplaceContents("Test", "Test1", rData)

End Sub

Public Sub ReplaceContents(ByVal SearchItem As String, ByVal ReplaceItem As String, ByVal DataArea As Range)

Dim rPtr As Range
Dim sFirstCell As String
Dim bFinished As Boolean

Set rPtr = DataArea.Find(SearchItem, DataArea(DataArea.Count), XlFindLookIn.xlValues)
If Not rPtr Is Nothing Then
    sFirstCell = rPtr.Address
    Do While bFinished = False
        rPtr.Value = ReplaceItem
        Set rPtr = DataArea.FindNext(rPtr)
        If StrComp(rPtr.Address, sFirstCell, vbTextCompare) = 0 Then bFinished = True
    Loop
End If

End Sub

Answer 2

查看http://www.excel-easy.com/vba/loop.html

您需要做的是按照上面的链接。然后你将得到列＃34; B＆＃34;中使用的总行数。并使用它作为你的for循环的结束。

所以基本上它会像

For i = 2 to columnBCount
    do code.......
next

您只需要用实际的方式替换columnBCount即可获得计数。

我已将i设为2，如果您有标题，则不会包含它们，并从第二行开始。

但请阅读链接中的循环

Answer 3

我看到你正在使用'find'命令，你可以使用'findnext'

Dim rng As Range
With ActiveSheet
    set c = .Columns("B:B").Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Offset(-1, -1)

    if c is not nothing then
        firstaddress  = c.address
     do
        c.select
    .Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(, 15).Select
    Selection.Offset(, 1).Select

    Set rng = Selection
    .PageSetup.PrintArea = rng.Address
    .PageSetup.Orientation = xlLandscape
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = 999
    .PageSetup.PrintTitleRows = "$1:$4"
    .PageSetup.LeftMargin = Application.InchesToPoints(0.45)
    .PageSetup.RightMargin = Application.InchesToPoints(0.2)
    .PageSetup.TopMargin = Application.InchesToPoints(0.25)
    .PageSetup.BottomMargin = Application.InchesToPoints(0.25)
    .PageSetup.HeaderMargin = Application.InchesToPoints(0.3)
    .PageSetup.FooterMargin = Application.InchesToPoints(0.3)
    .PageSetup.PaperSize = xlPaperA4
    .PageSetup.CenterHorizontally = True
    .PageSetup.CenterVertically = False


    Selection.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:="C:Users\kgs-aizat.kassim\Desktop\" & ActiveCell.Offset(0, -1).Value & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    loop While Not c Is Nothing And c.Address <> firstAddress 
End if 
end with
 End Sub

这将遍历符合条件的所有单元格

如何做循环vba

3 个答案: