Невозможно перейти к следующему условию без выхода Sub - PullRequest
0 голосов
/ 26 марта 2019

У меня есть листы с именами, такими как M & MFIN.NS, M & M.NS, L & TFH.NS, я пытаюсь найти один из них и затем выполнить определенную задачу. Однако, если один из вышеупомянутых листов не найден, код завершается (Exit Sub). Мне нужна помощь, если лист не найден, он должен перейти к следующему параметру поиска, а затем к остальному коду

Пожалуйста, руководство

Sub SearchSheetNameandcreatenewsheet()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Dim sName As String
Dim sFound As Boolean

sName = "M&MFIN.NS"

If sName = "" Then Exit Sub

sFound = False

On Error Resume Next
    ActiveWorkbook.Sheets(sName).Select
    Range(Range("E3"), Range("E3").End(xlDown)).Select
    Selection.Copy
    Worksheets("Close Price").Activate
    Cells.Find(What:="M&MFIN.NS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Dim sName1 As String
Dim sFound1 As Boolean

sName1 = "M&M.NS"

If sName1 = "" Then Exit Sub
sFound1 = False

On Error Resume Next
    ActiveWorkbook.Sheets(sName1).Select
    Range(Range("E3"), Range("E3").End(xlDown)).Select
    Selection.Copy
    Worksheets("Close Price").Activate
    Cells.Find(What:="M&M.NS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Dim sName2 As String
Dim sFound2 As Boolean

sName2 = "L&TFH.NS"

If sName2 = "" Then Exit Sub
sFound2 = False

On Error Resume Next
    ActiveWorkbook.Sheets(sName2).Select
    Range(Range("E3"), Range("E3").End(xlDown)).Select
    Selection.Copy
    Worksheets("Close Price").Activate
    Cells.Find(What:="L&TFH.NS", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("A1").CurrentRegion.Select
    Selection.Replace What:="null", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


'"creating close price sheet seperataly"

Sheets("Close Price").Select
Sheets("Close Price").Copy


ChDir "C:\Lookback Momentum Analysis"
ActiveWorkbook.SaveAs Filename:= _
    "C:\Lookback Momentum Analysis\Close Price.xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Worksheets("Parameters").Activate

End Sub

1 Ответ

0 голосов
/ 26 марта 2019

Это будет вариант:

Option Explicit
Sub SearchSheetNameandcreatenewsheet()

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim wb As Workbook, ws As Worksheet

    Set wb = ThisWorkbook 'the workbook which has the code

    For Each ws In wb.Worksheets
        Select Case ws.Name

            Case "M&MFIN.NS"
                'code
            Case "M&M.NS"
                'code
            Case "L&TFH.NS"
                'code
        End Select
    Next ws

End Sub

Вам необходимо вводить только имена листов и вводить код под каждым Case для конкретных имен листов.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...