как двигаться вниз на 1 строку для каждой петли, пока ячейка не станет пустой - PullRequest
0 голосов
/ 16 мая 2018

Как мне переместиться на 1 строку вниз для каждого цикла, пока ячейка не будет пуста в столбце A?

Мне нужно начать со строки 5, скопировать в другую книгу и затем перейти к следующей строке (строка 6), пока содержимое не станет пустым,

Вот мой код

    Sub Macro3()
'''
Do

''GRAB A ROW
    Windows("theFILE2.working.xlsm").Activate
    Rows("5:5").Select
    Selection.Copy
    Workbooks.Open "D:\folder1\folder2\Projects\The FILES\New folder\OVERVIEW TEMPLATE(macro edition)(current).xlsm"
    Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
    Sheets("LISTS").Select
    Rows("4:4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Windows("OVERVIEW TEMPLATE(macro edition)(current).xlsm").Activate
    Sheets("PLANT OVERVIEW").Select

''SAVE AS
    Dim Path As String
    Dim FileName1 As String
    Dim FileName2 As String


    FileName1 = Range("N1").Value
    FileName2 = Range("A1").Value

    Path = "D:\folder1\folder2\Projects\The FILES\theFILES\" & FileName1 & "\"

    ActiveWorkbook.SaveAs Filename:=Path & FileName2 & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

    ActiveWorkbook.Close

Loop

End Sub

Спасибо заранее!

1 Ответ

0 голосов
/ 17 мая 2018

Я вижу, что вы новичок в VBA, и есть некоторые концепции, которые вы быстро понимаете. Запись макросов в Excel - отличный способ узнать, как можно что-то сделать в Excel. Однако у Excel также есть некоторые недостатки. Вот несколько понятий, которые помогут:

  1. Не использовать Выбор , ActiveCell , ActiveSheet , Выбрать , Активируйте и т. Д., Если вам абсолютно не нужно. Я знаю, что это именно то, что делает Macro Recorder в Excel, но если вы сделаете это неправильно, это может привести к ошибкам, особенно когда вы начинаете работать с несколькими книгами!

    Намного лучше назначить объект и использовать этот объект, чтобы делать то, что вы хотите. В приведенном ниже коде я назначил Рабочие книги и рабочие таблицы объектам и использовал их для выполнения работы. Диапазоны также являются общими объектами для использования.

  2. В связи с этим, всегда полностью квалифицируйте ваши объекты . Например, вы можете написать код, подобный следующему: Var1 = Cells(1, 1).Value, но он будет получать значение из ячейки A1 в Active Worksheet , а не обязательно в том листе или книге, которые вы намеревались. Намного лучше написать это так: Var1 = wksSource.Cells(1, 1).Value Я указал имя листа "Лист1" для вашей исходной рабочей книги - замените его на фактическое имя листа, который вы копируете из .

  3. Я назначил наиболее распространенные строки для Константы вверху. Существует баланс между назначением каждой строки константе и использованием только строковых строк (например, некоторые могут назначать имена листов, например, «LISTS», константе), но если они используются только один раз и на видном месте, Я не волнуюсь о назначении константы для этого. Но особенно когда значение используется в нескольких местах, константа облегчает, когда вы хотите повторно использовать код для аналогичной задачи. Я также добавил туда константу для исходного пути, хотя это не требуется, если рабочая книга уже открыта.

  4. Я также объявил все переменные вверху - некоторые языки и программисты делают это по-разному, но мне нравится видеть, что используется в начале.

  5. Обратите внимание на спецификатор While на вашем Do ... Loop . Это будет выполнено только в том случае, если в первом столбце текущей строки есть значение.

Вот как бы я написал код для вашей задачи:

Sub Macro3()

    Dim SourceRow As Long
    Dim DestRow As Long
    Dim Path As String
    Dim FileName1 As String
    Dim FileName2 As String
    Dim FullFileName As String

    Dim wkbSource As Workbook
    Dim wksSource As Worksheet
    Dim wkbDest As Workbook
    Dim wksDest As Worksheet
    Dim wksDest2 As Worksheet

    Const scWkbSourcePath As String = "D:\folder1\folder2\Projects\"        ' For example
    Const scWkbSourceName As String = "theFILE2.working.xlsm"
    Const scWkbDest1Path As String = "D:\folder1\folder2\Projects\The_FILES\New_folder\"
    Const scWkbDest1Name As String = "OVERVIEW TEMPLATE_macro edition_current_.xlsm"
    Const scWkbDest2Path As String = "D:\folder1\folder2\Projects\The_FILES\theFILES\"

    Set wkbSource = Workbooks(scWkbSourceName)
    Set wksSource = wkbSource.Sheets("Sheet1")      ' Replace Sheet1 with the sheet name
    SourceRow = 5
    DestRow = 4

Do While wksSource.Cells(SourceRow, 1).Value <> ""
    ' Open the template workbook
    Set wkbDest = Workbooks.Open(scWkbSourcePath & scWkbDest1Name)
    Set wksDest = wkbDest.Sheets("LISTS")

''COPY A ROW
    wksSource.Rows(SourceRow).Copy Destination:=wksDest.Rows(DestRow)
    Application.CutCopyMode = False
    With wksDest.Rows(DestRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    wkbDest.Activate
    Set wksDest2 = wkbDest.Sheets("PLANT OVERVIEW")

''SAVE AS
    FileName1 = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
        Replace(wksDest2.Range("N1").Value _
        , ".", "_") _
        , "/", "_") _
        , "\", "_") _
        , "?", "_") _
        , "|", "_") _
        , "<", "_") _
        , ">", "_") _
        , ":", "_") _
        , "*", "_") _
        , """", "_")
    FileName2 = wksDest2.Range("A1").Value

    Path = scWkbDest2Path & FileName1 & "\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MkDir Path
    End If
    FullFileName = Path & FileName2 & ".xlsx"
    wkbDest.SaveAs Filename:=FullFileName, FileFormat:=xlOpenXMLWorkbook
    wkbDest.Close

    ' Best practice to set objects to Nothing before re-using an object variable
    Set wksDest = Nothing
    Set wksDest2 = Nothing
    Set wkbDest = Nothing

    ' Move down 1 row for source sheet
    SourceRow = SourceRow + 1
Loop

End Sub

Редактировать

Некоторые заметки и вещи, которые я узнал относительно символов имени папки и файла:

  • Хотя в именах файлов можно использовать скобки * , я не смог сохранить исходное имя файла для сохранения, но удаление скобок решило проблему.
  • Поскольку вы создаете имена файлов и папок из (потенциально грязных) данных, вы должны очистить (удалить или заменить на _ ) символы, которые нельзя использовать в этих именах: \ / | ? <</strong> > : * "
  • Я нашел это на странице Microsoft для Именования файлов, путей и пространств имен :

Не заканчивайте имя файла или каталога пробелом или точкой.

  • Хотя это разрешено внутри имени файла, точка остановки (. ) не может быть последним символом имени папки, как правило, там, где вы найдете его в текстовой строке. Кроме того, это может сбивать с толку и иногда вызывать проблемы в имени файла, поэтому я рекомендую заменить их все.

    • Функция Trim () может использоваться для удаления пробелов в конце имени папки . Имейте в виду, что внутри строки он также заменяет несколько пробелов в строке на один пробел.
  • Тем более что вы создаете папки из данных, вы должны убедиться, что папка существует, прежде чем сохранять в нее файл. MkDir - команда для этого.

  • Если ваша рабочая книга шаблона не открыта при запуске, вам может потребоваться указать путь и в операторе Open ().
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...