Question

我的工作簿中有2张纸表格1-A2及以上的我有数字名为“ LOC”的工作表，我一次将1个数字重新计算并形成并保存

必须对工作表1-A2和下方输入的所有数字重复此过程，直到列末

请帮我循环一下

我必须复制工作表1中的每个数字，并将其粘贴到C2中名为“ LOC”的Heet中，然后再次重复该过程

Sub MultipleSOA()
 '1st SOA

Sheets("Sheet1").Select
Range("A2").Select
Selection.Copy
Sheets("Loc ").Select
Range("C2").Select
ActiveSheet.Paste

ActiveSheet.Calculate

Range("B9:G9").Select
Cells.Replace What:="PCL-", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="SCL-", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="PSI-", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="CL-", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("B9:G9").Select

Range("C4").Select
Columns("C:C").ColumnWidth = 44.29
Range("C4").Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\XXXX\Desktop\SOA\" & ActiveSheet.Range("B9").Value & " - " & ActiveSheet.Range("C2").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

Answer 1

我还没有测试过，但是尝试下面的代码...

Option Explicit

Sub MultipleSOA()

    Dim varItemsToReplace As Variant
    Dim varItem As Variant
    Dim wksSource As Worksheet
    Dim wksDest As Worksheet
    Dim rngSource As Range
    Dim rngCell As Range

    varItemsToReplace = Array("PCL-", "SCL-", "PSI-", "CL-")

    Set wksSource = Worksheets("Sheet1")
    Set wksDest = Worksheets("Loc")

    With wksSource
        Set rngSource = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With

    For Each rngCell In rngSource
        With wksDest
            .Range("C2").Value = rngCell.Value
            .Calculate
            For Each varItem In varItemsToReplace
                .Range("B9:G9").Replace _
                    What:=varItem, _
                    Replacement:="", _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    MatchCase:=False, _
                    SearchFormat:=False, _
                    ReplaceFormat:=False
            Next varItem
            .Columns("C:C").ColumnWidth = 44.29
            .ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:="C:\Users\XXXX\Desktop\SOA\" & .Range("B9").Value & " - " & .Range("C2").Value & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
        End With
    Next rngCell

End Sub

需要VBA循环帮助

1 个答案: