Как перейти к следующей доступной строке - EXCEL VBA - PullRequest
0 голосов
/ 27 марта 2019

У меня есть код Excel VBA, который просматривает папку и копирует данные в текущую рабочую книгу. Где бы разместить строку кода для перехода к следующей доступной пустой строке при повторном запуске кода?

Я предполагаю, что использовал бы следующую строку кода, но она, кажется, не работает там, где она у меня расположена в разделе «Выбор значений из ячеек»:

    twb.Worksheets("Log").Range("A65536").End(xlUp).Offset(1, 0).Select

Мой полный код:

    Sub RenameExcelInDir()

    Dim MyPath As String
    Dim MyFile As String
    Dim MyExt As String
    Dim MyNewName As String
    Dim MyVendor As String
    Dim MyFAC As String
    Dim MyFabric As String
    Dim MyFiberC As String
    Dim MyKnit As String
    Dim MyWoven As String
    Dim MyDesc As String
    Dim wb As Workbook
    Dim twb As Workbook
    Dim wks As Worksheet
    Dim r As Range
    Dim getDate As String

    'Opens File Dialog Window to choose dir to search in

With Application.FileDialog(msoFileDialogFolderPicker)
   .Show
   MyPath = .SelectedItems(1)
End With

getDate = Date

Set twb = ThisWorkbook

Set r = twb.Worksheets("Log").Range("A2")

MyFile = Dir(MyPath & "\*.*")

Do While Len(MyFile) > 0
    MyExt = Split(MyFile, ".")(UBound(Split(MyFile, ".")))

    Set wb = Workbooks.Open(MyPath & "\" & MyFile, UpdateLinks:=0)


    'Loops through the worksheet collection

For Each wks In wb.Worksheets

Select Case wks.Name

    Case "ISU Form"
    MyNewName = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C23").Value & "." & MyExt)
    MyVendor = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C21").Value)
    MyFAC = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C25").Value)
    MyDesc = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C14").Value)
    MyFabric = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C15").Value)
    MyFiberC = ValidFileName(FileName:=wb.Sheets("ISU FORM").Range("C17").Value)

    Case "GLOBAL ISU"
    MyNewName = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("M26").Value & "." & MyExt)
    MyVendor = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D18").Value)
    MyFAC = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D21").Value)
    MyDesc = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D26").Value)
    MyFabric = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D64").Value)
    MyFiberC = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D66").Value)
    MyKnit = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("D68").Value)
    MyWoven = ValidFileName(FileName:=wb.Sheets("GLOBAL ISU").Range("F68").Value)

End Select

Next wks

wb.Close

      'Select Values from cells
twb.Worksheets("Log").Range("A65536").End(xlUp).Offset(1, 0).Select
r.Value = MyFile
r.Offset(, 1).Value = MyNewName
r.Offset(, 2).Value = getDate
r.Offset(, 3).Value = MyVendor
r.Offset(, 4).Value = MyFAC
r.Offset(, 5).Value = MyDesc
r.Offset(, 6).Value = MyFabric
r.Offset(, 7).Value = MyFiberC
r.Offset(, 8).Value = MyKnit
r.Offset(, 9).Value = MyWoven
r.Offset(, 10).Value = MyPath
Set r = r.Offset(1)
Name MyPath & "\" & MyFile As MyPath & "\" & MyNewName
MyFile = Dir


Loop

End Sub

и функция ValidFileNameFunction:

   Function ValidFileName(ByVal FileName As String) As String
Dim myarray() As Variant
Dim x
'check for illegal characters
myarray = Array("[", "]", "\\", "/", "*", "\", "?", "<>", "<", ">", ":", "|", "&")
For x = LBound(myarray) To UBound(myarray)
    FileName = Replace(FileName, myarray(x), "", 1)
Next x
ValidFileName = FileName
    End Function

Я бы хотел перейти к следующей строке в рабочей таблице «Журнал» при повторном запуске кода. Мои текущие результаты тестирования просто перезаписывают первые две строки в тестовой папке. Любая помощь будет принята с благодарностью. Спасибо!

1 Ответ

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

Спасибо всем за помощь. Мне удалось успешно выполнить это с помощью следующего кода:

Dim nextrow As Long

nextrow = Cells(Rows.Count, "A").End(xlUp).row

Мне пришлось изменить одну или две строки в существующем коде, чтобы заставить его работать, но это работает! :) Спасибо всем за ссылки на статьи, которые объясняли, что мне нужно. Ура! * * 1004

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