如何做while while vba

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

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

你需要做的是按照鏈接以上。然後，您將獲得「B」列中使用的總行數，並將其用作for循環的結束。

所以基本上它會像

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

你只需要一個實際的方式來獲得的計數來代替columnBCount。

我已將i設置爲2如果您有標題，則不包括它們並從第二行開始。

但是從鏈接

Answer 2

閱讀了關於環下面是一些代碼，將搜索欄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 3

我看到你正在使用的「查找」命令，你可以使用「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 

這將遍歷符合您的標準