Question

我是VBA的新手。我一直在研究过去的代码，以帮助我建立自己的代码。

我的问题是sub1和sub2完全靠自己工作。 Sub1遍历工作簿中的所有工作表，而sub2仅适用于活动工作簿。因此，当我遍历sub1中的工作表时，我想调用sub2。这两个潜艇不相关，因此我没有任何输入可以使用从sub1到sub2。

Sub titles()
Dim titles() As Variant
Dim ws As Worksheet
Dim wb As Workbook
Dim i As Long

Application.ScreenUpdating = False

Set wb = ActiveWorkbook


titles() = Array("Distance", "Count", "Fe %", "Cr %", "Fe (Mean)", "Fe (std)", "Cr (Mean)", "Cr(std)", "x", "Fe", "x", "Cr", "x", "Fe", "x", "Cr", "Fe W", "Fe A", "Cr W", "Cr A")

For Each ws In wb.Sheets

    With ws
    For i = 41 + LBound(titles()) To 41 + UBound(titles())

        .Cells(1, 1 + i).Value = titles(i - 41)

    Next i

    End With

 **Formulas ws**



Next ws


Application.ScreenUpdating = True

End Sub



**Public Sub Formulas(ws As Worksheet)**

**With ws**


   Dim R As Long
   Dim OutR1   As Long, OutR2 As Long, outRow As Long
   Dim MaxRow1 As Long, MaxRow2 As Long
   Dim SeriesFlag As Integer



   Range(Cells(2, "AX"), Cells(ActiveSheet.UsedRange.Rows.Count, "BE")).ClearContents

   R = 2

   outRow = 2

    Do Until Cells(R, "AP") = ""


   MaxRow1 = NextMaximumRow(R:=R, DataCol:=Range("AR1").Column, WMean:=Range("AT2"), WSErr:=Range("AU2"))


   If MaxRow1 > 0 Then

   Cells(outRow, Range("AX1").Column) = Cells(MaxRow1, "AP") ' x
   Cells(outRow, Range("AY1").Column) = Cells(MaxRow1, Range("AR1").Column)       ' y

   Cells(outRow, Range("AZ1").Column) = Cells(MaxRow1, "AP") ' x
   Cells(outRow, Range("BA1").Column) = 0       ' y

   R = R + 1

   outRow = outRow + 1
   End If



  If MaxRow1 = 0 Then
   R = R + 1
  End If



   R = R + 1

   Loop


   R = 2

   Do Until Cells(R, "AP") = ""



    MaxRow2 = NextMaximumRow(R:=R, DataCol:=Range("AS1").Column, WMean:=Range("AV2"), WSErr:=Range("AW2"))


    If MaxRow2 > 0 Then


   Cells(outRow, Range("AZ1").Column) = Cells(MaxRow2, "AP") ' x
   Cells(outRow, Range("BA1").Column) = Cells(MaxRow2, Range("AS1").Column)       ' y
   Cells(outRow, Range("AX1").Column) = Cells(MaxRow2, "AP") ' x
   Cells(outRow, Range("AY1").Column) = 0       ' y


    R = R + 1

   outRow = outRow + 1
   End If


  If MaxRow2 = 0 Then
   R = R + 1
  End If


   R = R + 1

   Loop

 Call Range("AX:BA").Sort(Key1:=Range("AX1"), Order1:=xlAscending, Header:=xlYes)


 R = 2
 OutR1 = 2
 OutR2 = 2

 Dim PeakRow1 As Long, PeakRow2 As Long

  ' Which series has the first Peak?


   PeakRow1 = NextPeakRow(R:=2, DataCol:=Range("AY1").Column)

   PeakRow2 = NextPeakRow(R:=2, DataCol:=Range("BA1").Column)

   If PeakRow1 < PeakRow2 And PeakRow1 > 0 Then
      Cells(OutR1, Range("BB1").Column) = Cells(PeakRow1, "AX") ' x
      Cells(OutR1, Range("BC1").Column) = Cells(PeakRow1, Range("AY1").Column)         ' y
      OutR1 = OutR1 + 1
      SeriesFlag = 2 ' next series to check
      R = PeakRow1

   ElseIf PeakRow2 > 0 Then
      Cells(OutR2, Range("BD1").Column) = Cells(PeakRow2, "AX") ' x
      Cells(OutR2, Range("BE1").Column) = Cells(PeakRow2, Range("BA1").Column)         ' y
      OutR2 = OutR2 + 1
      SeriesFlag = 1 ' next series to check
      R = PeakRow2

    ElseIf PeakRow2 = 0 Then
    SeriesFlag = 1
    R = PeakRow2 + 1

    ElseIf PeakRow1 = 0 Then
    SeriesFlag = 2
    R = PeakRow1 + 1

   Else
      MsgBox "There is no Peak"
      Exit Sub
   End If

   R = R + 1

   Do Until Cells(R, "AP") = ""

      Select Case SeriesFlag

         Case 1

            PeakRow1 = NextPeakRow(R:=R, DataCol:=Range("AY1").Column)
            If PeakRow1 > 0 Then
      Cells(OutR1, Range("BB1").Column) = Cells(PeakRow1, "AX") ' x
      Cells(OutR1, Range("BC1").Column) = Cells(PeakRow1, Range("AY1").Column)         ' y
      OutR1 = OutR1 + 1
      SeriesFlag = 2
      R = PeakRow1

            End If

         Case 2

            PeakRow2 = NextPeakRow(R:=R, DataCol:=Range("BA1").Column)
           If PeakRow2 > 0 Then
      Cells(OutR2, Range("BD1").Column) = Cells(PeakRow2, "AX") ' x
      Cells(OutR2, Range("BE1").Column) = Cells(PeakRow2, Range("BA1").Column)         ' y
      OutR2 = OutR2 + 1
      SeriesFlag = 1 ' next series to check
      R = PeakRow2

            End If

         Case Else
            Stop

      End Select

      R = R + 1

   Loop

 **End With**

 End Sub

Answer 1

您需要的一般结构是

Sub Sub1()
    Dim ws As Worksheet
    For Each ws In wb.Sheets
        ' other code
        Sub2 ws
    Next
End Sub

Sub Sub2(ws as Worksheet)
    ' work with ws object
    ' eg
    With ws
        .Cells(11, 1).Formula = "=Sum(A1:A10)"
    End With
End Sub

将Sub调用到所有工作表

1 个答案: