如何做while循环vba

我有编写的代码（如下所示），在列B中find“ Total ”一词。然后将select导出到PDF。 然后， Done Total ”一词由Done取代。

我试图find一种方法来重复此代码，直到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

这里有一些代码将searchB列的所有SearchItem条目。 你需要在这里包含一个对你的PDF处理的调用。

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

rPtr.Value = ReplaceItem

代码仍然只能find一次单元格。

 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

你需要做的是按照上面的链接。 然后，您将获得“B”列中使用的总行数，并将其用作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 

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