Question

我创建了一个宏，该宏可以从某个文件夹收集我的excel文件。就目前而言，它运作良好，但我想更改两件事，但我不知道如何更改。

现在，宏将从我将设置的范围中收集数据。
如何添加条件以仅从不为空的行中收集数据。
宏需要检查17行及以下的行，并收集所有不为空的行。
在每行宏下创建一个空行。
我该如何改变呢？我不知道为什么它是诚实的。

宏代码：

Sub Scalanie_plikow()

    Dim bookList As Workbook
    Dim MergeObj As Object, dirObj As Object, filesObj As Object, everyObj As
    Object
    Application.ScreenUpdating = False
    Set MergeObj = CreateObject("Scripting.FileSystemObject")
    Dim Folder As String
    Dim Obszar As String

    Folder = WskazFolder("Wska? folder z plikami do scalenia", "Scalaj")
    If Len(Folder) = 0 Then
        MsgBox "Nie wskazano foldera ?ród?owego", vbExclamation, WERSJA
        Exit Sub
    End If
    Set dirObj = MergeObj.Getfolder(Folder)
    Set filesObj = dirObj.Files
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        If Obszar = "" Then
            On Error Resume Next
            Obszar = Application.InputBox("Wpisz adres lub zaznacz obszar kopiowania", ,_
            "A1:K10", Type:=8).Address(0, 0)
            On Error GoTo 0
            If Obszar = "" Then Exit Sub
        End If
        bookList.Worksheets(4).Range(Obszar).Copy

        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial xlPasteFormats
        Range("A65536").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        bookList.Close
        Range("A65536").End(xlUp).Offset(1, 0).Select


        ActiveCell.FormulaR1C1 = " "

        Selection.Resize(Selection.Rows.Count + 0, Selection.Columns.Count +   10).Select

        Range("A65536").End(xlUp).Offset(1, 0).Select
        ActiveCell.FormulaR1C1 = " "
    Next

    MsgBox "Liczba scalonych plików: " & filesObj.Count

    Columns("A:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:N").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:L").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Asset ID"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Expense Start Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Expense End Date"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Template Identifier"
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit

End Sub

Function WskazFolder(TytulOkna As String, TytulPrzycisku As String) As String
    Dim Okno As FileDialog
    Dim Wybrane As String
    Set Okno = Application.FileDialog(msoFileDialogFolderPicker)
    Okno.Title = TytulOkna
    Okno.ButtonName = TytulPrzycisku
    If Okno.Show = -1 Then
        Wybrane = Okno.SelectedItems(1)
        If Right(Wybrane, 1) <> "\" Then
            WskazFolder = Wybrane & "\"
        Else
            WskazFolder = Wybrane
        End If
    End If
End Function

收集文件的宏版本

0 个答案: