Vba 仅当下一行为空时在一列中打印

我有从文件夹中的文件打印到excel工作表第1、2、3和4列的信息。第1列和第2列只包含一个信息单元，但第2列和第3列的长度不同，但彼此相等

我的目标是对A列执行类似的操作，如果B列中它旁边的单元格被占用，则转到下面的行并循环，否则如果单元格为空，则打印该行中第1列的信息

这是完整的代码

Option Explicit

Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim StartSht As Worksheet, ws As Worksheet
    Dim WB As Workbook
    Dim i As Integer
    Dim LastRow As Integer, erow As Integer
    Dim Height As Integer
    Dim RowLast As Long

    'turn screen updating off - makes program faster
    'Application.ScreenUpdating = False

    'location of the folder in which the desired TDS files are
    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

    'Set StartSht = ActiveSheet
    Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1")

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 1

    'loop through directory file and print names
'(1)
    For Each objFile In objFolder.Files
        If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
'(2)
            'print file name to Column 1
            Workbooks.Open fileName:=MyFolder & objFile.Name
            Set WB = ActiveWorkbook
'(3)
            'copy HOLDER column from F11 (11, 6) until empty
            LastRow = Cells(Rows.count, 1).End(xlUp).Row
            Range(Cells(11, 6), Cells(LastRow, 6)).Copy
            StartSht.Activate
            'print HOLDER column to column 2 in masterfile in next available row
            Range("B" & Rows.count).End(xlUp).Offset(1).PasteSpecial
            WB.Activate
'(4)
            'copy CUTTING TOOL column from F11 (11, 7) until empty
            LastRow = Cells(Rows.count, 1).End(xlUp).Row
            Range(Cells(11, 7), Cells(LastRow, 7)).Copy
            StartSht.Activate
            'print CUTTING TOOL column to column 3 in masterfile in next available row
            Range("C" & Rows.count).End(xlUp).Offset(1).PasteSpecial
            WB.Activate

'(5)
            'print TDS information
            With WB
                For Each ws In .Worksheets
                        'print the file name to Column 1
                        StartSht.Cells(i + 1, 1) = objFile.Name
                        'print TDS name to Column 4
                        With ws
                            .Range("J1").Copy StartSht.Cells(i + 1, 4)
                        End With
                        i = i + 1

                'move to next file
                Next ws
'(6)
                'close, do not save any changes to the opened files
                .Close SaveChanges:=False
            End With
        End If
    'move to next file
    Next objFile
    'turn screen updating back on
    'Application.ScreenUpdating = True
    ActiveWindow.ScrollRow = 1
'(7)
End Sub

我的最终目标是让我的excel工作表看起来像这样：（之前和之后）

---

让我们看看这是否能让你更接近：

'(2)
            'print file name to Column 1
            Set WB = Workbooks.Open fileName:=MyFolder & objFile.Name
            Set ws = WB.ActiveSheet
'(3)
            'copy HOLDER column from F11 (11, 6) until empty
            With ws
                lastRow = GetLastRowInColumn(ws, "A")
                .Range(.Cells(11,6), .Cells(lastRow, 6)).Copy
            End With

    Dim destination
    lastRow = GetLastRowInColumn(startSht, "B")
    Set destination = StartSht.Range("B" &   lastRow).Offset(1)
            'print HOLDER column to column 2 in masterfile in next available row
            destination.PasteSpecial
'(4)

            'ReDefine the destination range to paste into Column C
            lastRow = GetLastRowInColumn(startSht, "C")
            Set destination = StartSht.Range("C" & lastRow).Offset(1)

            With ws
                'copy CUTTING TOOL column from F11 (11, 7) until empty
                LastRow = GetLastRowInColumn(ws, "G")
                'print CUTTING TOOL column to column 3 in masterfile in next available row
                .Range(.Cells(11, 7), .Cells(LastRow, 7)).Copy _
                    Destination:=destination
            End With
'(5)
            With WB
               'print TDS information
                For Each ws In .Worksheets
                        'Determine what is the last row in this sheet, +1 to get the next empty row
                        i = GetLastRowInSheet(ws) +1

                        'print the file name to Column 1
                        StartSht.Cells(i, 1) = objFile.Name
                        'print TDS name to Column 4
                        With ws
                            .Range("J1").Copy StartSht.Cells(i, 4)
                        End With

                'move to next file
                Next ws
'(6)
                'close, do not save any changes to the opened files
                .Close SaveChanges:=False
            End With

重要的一点是，我们不是简单地将

i

增加一，而是使用

GetLastRowInSheet

函数（如下）将

i

重置为工作表中的最后一行+1

i = GetLastRowInSheet(ws) + 1

您需要包含这两个函数，其目的是简化确定

LastRow

的笨拙（重复）方式。（借用自）

函数GetLastRowInColumn（工作表作为工作表，列作为字符串） 使用工作表 GetLastRowInColumn=.Range（列和.Rows.Count）.End（xlUp）.Row 以 端函数 函数GetLastRowInSheet（工作表作为工作表） 暗网 使用工作表 如果Application.WorksheetFunction.CountA（.Cells）为0，则 ret=.Cells.Find（What:=“*”_ 之后：=.范围（“A1”）_ 看：=xlPart_ LookIn:=xl公式_ 搜索顺序：=xlByRows_ 搜索方向：=xlPrevious_ MatchCase:=False）。行 其他的 ret=1 如果结束 以 GetLastRowInSheet=ret 端函数

---

看起来您并没有尝试任何方法来解决问题。到目前为止，您已经描述了一些逻辑。你能试着在代码中实现它吗？实际上我已经尝试了很多次，但都没有成功，并且开始弄乱我的其他代码，这就是为什么我没有在代码中添加任何内容。我一直在尝试制定如何解决这个问题，我刚才认为最简单的解决方案是将“名称”从第1列和第4列一直打印到第2列和第3列中填充的最后一个单元格，然后插入一个空行，并继续这样循环。。。不过我不知道该怎么做。我是VBA@davidzemens的新手。根据你在Q中包含的代码，现在还不清楚你的“after”是如何从“before”派生出来的。您提供的代码是一个覆盖所有工作表的循环——因此您正在处理

ws

迭代，并对

StartSht

对象做一些事情——我认为如果不访问工作簿，或者没有更好的公式化问题，帮助解决这个问题确实很困难。很抱歉您可能应该在问题中输入完整的代码。这不是压倒性的：）如果您想访问工作簿，我有测试仪输入文件和代码如果您想让我将它们作为help@DavidZemensHm发送给您，For循环开始时的I=导致第一个文件名位置为空，并移动到第二个文件名位置（在正确的位置，尽管如此！）第二个移动到第三个的位置…如此类推，我得到它现在抓取表格中的最后一行并打印名称。。。我试着移动它，让它先打印出名字，但我似乎把我的代码搞得更糟了…这是不是解决问题的错误方法？我甚至不知道你在问什么。为什么只要它在正确的行中打印名称，它是否打印名称“first”就很重要？让我们来吧。对不起，伙计，我没有时间教你VBA。我已经为您完成了95%的解决方案——另外5%只是因为我不确定发生了什么（我正在编写没有文件的代码，所以我看不到发生了什么），而您正在关注一些细节。你将通过反复试验来解决这个问题。

Function GetLastRowInColumn(theWorksheet as Worksheet, col as String)
    With theWorksheet
        GetLastRowInColumn = .Range(col & .Rows.Count).End(xlUp).Row
    End With
End Function

Function GetLastRowInSheet(theWorksheet as Worksheet)
Dim ret
    With theWorksheet
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            ret = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            ret = 1
        End If
    End With
    GetLastRowInSheet = ret
End Function