Повторите макрос и сохраняйте его каждый раз под другим именем - PullRequest
0 голосов
/ 16 марта 2020

У меня есть код ниже, чтобы автоматизировать определенное действие и сохранить файл. Но мне нужно повторять действие и каждый раз сохранять его под другим именем. 3 раза уточняется c.

Я не уверен, что это лучший способ сделать это. Пожалуйста, помогите

Sub Proof()
Dim i As Long, Di As Long, Bi As Long
Const Dfirstrow As Double = 222
Const Bfirstrow As Double = 222
Dim Dlastrow As Long, Blastrow As Long
Dim Dmyvalue As Double, Bmyvalue As Double
Range("A2").Value = "Date / Time: " & Format(Now, "dd.mm.yyyy / hh:nn:ss")
Dlastrow = Range("BE" & Dfirstrow).End(xlDown).Row
For Di = Dfirstrow To Dlastrow
Dmyvalue = Range("BE" & Di).Value
If Dmyvalue < 100 Then Range("BE" & Di).Value = -9 + Rnd * -3
Next Di
Blastrow = Range("AD" & Bfirstrow).End(xlDown).Row
For Bi = Bfirstrow To Blastrow
Bmyvalue = Range("AD" & Bi).Value
If Bmyvalue < 100 Then Range("AD" & Bi).Value = 46 + Rnd * 3
Next Bi
Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ThisWorkbook.SaveAs "C:\Users\sgfancyj\Desktop\Profile_Macros\NEW\A", FileFormat:=Excel.xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub

1 Ответ

0 голосов
/ 16 марта 2020

я добавил все oop и изменение имени файла для каждого сохранения, просто настройте часть имени файла, и код должен соответствовать go, прокомментируйте мой канал, если хотите узнать что-то еще https://www.youtube.com/watch?v=hfAhmae4iqA

Sub Proof()



    Dim x as long
    Dim i As Long, Di As Long, Bi As Long



    For x = 1 to 3 ‘however many times you would want to run it 

    Const Dfirstrow As Double = 222
    Const Bfirstrow As Double = 222
    Dim Dlastrow As Long, Blastrow As Long
    Dim Dmyvalue As Double, Bmyvalue As Double
    Range("A2").Value = "Date / Time: " & Format(Now, "dd.mm.yyyy / hh:nn:ss")
    Dlastrow = Range("BE" & Dfirstrow).End(xlDown).Row
    For Di = Dfirstrow To Dlastrow
    Dmyvalue = Range("BE" & Di).Value
    If Dmyvalue < 100 Then Range("BE" & Di).Value = -9 + Rnd * -3
    Next Di
    Blastrow = Range("AD" & Bfirstrow).End(xlDown).Row
    For Bi = Bfirstrow To Blastrow
    Bmyvalue = Range("AD" & Bi).Value
    If Bmyvalue < 100 Then Range("AD" & Bi).Value = 46 + Rnd * 3
    Next Bi
    Sheets.Select
    Cells.Copy
    Cells.PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
      ActiveWorkbook.SaveAs Filename:=St & " " & " " & Ex_Ref & " " & Ref & ‘the file will have say save as different names each time           
    EnFileFormat:=Excel.xlOpenXMLWorkbook
    Application.DisplayAlerts = True

      Debug.Print x & ".file saved."    ‘this displays this message in immediate window 
      Next x




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