Поле ввода VBA с петлей и шагом - PullRequest
0 голосов
/ 21 ноября 2018

Привет У меня есть следующий код ниже, который работает, но, как вы можете видеть, очень ручной с точки зрения цикла, пока ввод ввода не будет правильным.По сути, я хочу, чтобы код проверял, что число, введенное пользователем, равно 19 или любому номеру строки от 19 с шагом / приращением от 7, например, 26,33,40 и т. Д., Максимум до 1002, так что фактически мой диапазон проверки равенС 19 по 1002, с шагом 7 из 19. Я удалил часть кода myvalue для целей этого поста, чтобы уменьшить размер.Любая помощь будет оценена, спасибо.

sub InsertRows()

Dim lastRow As Long
Dim Row1 As Long
Dim Row2 As Long
Dim myvalue As Variant
Dim i As Long
Dim CancelTest As Variant
Dim Row As Range
Dim myPassword As String
 myPassword = "Password"

Application.ScreenUpdating = False

lastRow = 0
Do
myvalue = InputBox("Insert Rows Starting From Input Number:" & Chr(10) & _
                    "e.g. 19, 26, 33 (Multiples of 7)")
If StrPtr(myvalue) = 0 Then Exit Sub

If Not IsNumeric(myvalue) Then MsgBox "Numeric Values Only" & Chr(10) & _
                                   "Starting From Row 19 In Multiples Of 7"

Loop Until Val(myvalue) = 19 Or myvalue = 26 Or myvalue = 33 Or myvalue = 40 Or myvalue = 47 Or myvalue = 54 Or myvalue = 61 Or myvalue = 68 Or myvalue = 75 Or myvalue = 82 Or myvalue = 89 Or myvalue = 96 Or myvalue = 103 

If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub

With Sheet1
    .Select
    .Unprotect Password:=myPassword

   ActiveSheet.Outline.ShowLevels RowLevels:=2

    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Row1 = lastRow - 6
    Row2 = lastRow
    Rows(Row1 & ":" & Row2).Select
    Selection.Copy
End With

With Sheet1
    .Select
    Range("a" & myvalue).Select
    Selection.Insert Shift:=xlDown
    On Error GoTo 0
    Application.CutCopyMode = False
    lastRow = 0
    .Range("c11").Select
    .Protect Password:=myPassword, AllowFiltering:=True, AllowFormattingCells:=True, DrawingObjects:=False, Contents:=True, UserInterfaceOnly:=True, AllowFormattingRows:=True, AllowFormattingColumns:=True

End With

Application.ScreenUpdating = True

End Sub

1 Ответ

0 голосов
/ 21 ноября 2018

Использование оператора модов

=Loop Until Val((myvalue - 19) Mod 7)) = 0

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