Question

我有多个报告，需要按照特定的步骤将这些报告编译成一个主文件，然后在新数据的左侧添加一个日期。需要遵循的步骤是：

在目录中打开文件
根据文件名设置一个变量，以在以后的步骤中使用（我正在为此使用InputBox函数）
从该文件复制具有A列中数据的所有单元格
将单元格数据粘贴到主文件B列的第一个空白单元格中
如果B列中有数据，而A列中的相邻单元格为空，则将该单元格的值更改为在步骤2中选择的变量
关闭文件，然后打开目录中的下一个文件

因此，基本上，它需要打开文件X，将文件X的A列中的所有内容复制到母版的B列中，然后针对在B列中有数据的每一行在母版的B列中插入一个日期

我停留在步骤5上，无法找到一种方法来查找步骤4中粘贴了数据的所有单元格并将所有单元格的值直接设置在它们的左侧。

Option Explicit

Sub ImportGroups()
Dim fPATH As String, fNAME As String
Dim LR As Long, NR As Long
Dim wbGRP As Workbook, wsDEST As Worksheet
Dim dateChooser As Variant
Dim cell As Range


Set wsDEST = ActiveWorkbook.Sheets("Sheet1")


Application.DisplayAlerts = False

fPATH = "C:\<path>\"       'remember the final \ in this string

fNAME = Dir(fPATH & "*")        'get the first filename in fpath

Do While Len(fNAME) > 0
    Set wbGRP = Workbooks.Open(fPATH & fNAME)   'open the file
    LR = Range("A" & Rows.Count).End(xlUp).Row  'how many rows of info?

    If LR > 3 Then

        dateChooser = InputBox("Enter date based on this file name: " & fNAME)

        ActiveSheet.Range("A1:A" & LR).Copy
        wsDEST.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValue

        ' This is where I need to set the value of all cells adjacent to the pasted cells

    End If

    wbGRP.Close False   'close data workbook
        fNAME = Dir         'get the next filename
Loop
Application.DisplayAlerts = True

End Sub

Answer 1

也许是这样的。

您需要为每本工作簿（目标和导入）计算最后一行，而您目前正在为看起来像是的一本书进行计算。对于您的目标书，每次粘贴到新范围时，第一个可用的空白行（LR）都会更改，因此在打开另一本书之前，需要在循环内重新计算该行。在您的导入书上，每个文件大概都有不同的行，因此这需要它自己的最后一行计算（LR2）。
我对您的工作表进行了限定，其中ws指向目标书上的Sheet1。然后，我们将使用wbGRP.Sheets(1)来引用您打开的每本导入书上的第一张纸。这可能需要纠正（您在评论中待回复）
对于第5步，您将需要遍历ws上新粘贴的数据。这些行的存在位置可以从变量LR和LR2推导出。然后只需检查循环内Column A是否为空，并在所需列上输出dateChooser。我在此处的dateChooser中粘贴了Column B（也有您在评论中的回复）
对拥有Option Explicit表示感谢。我确实在这里重新组织了一些事情（在屏幕更新之外声明静态变量，对变量进行分组等。

这未经测试。在评论中遇到问题时将很乐意进行编辑

Option Explicit

Sub ImportGroups()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim fPATH As String, fNAME As String
Dim LR As Long, LR2 As Long, i As Long
Dim wbGRP As Workbook, dateChooser As Variant

fPATH = "C:\<path>\"
fNAME = Dir(fPATH & "*")

Application.DisplayAlerts = False
    Do While Len(fNAME) > 0
        Set wbGRP = Workbooks.Open(fPATH & fNAME)   'open the file
        LR = ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Row  'how many rows of info?

        If LR > 3 Then
            dateChooser = InputBox("Enter date based on this file name: " & fNAME)
            LR2 = wbGRP.Sheets(1).Range("A" & wbGRP.Sheets(1).Rows.Count).End(xlUp).Row
            wbGRP.Sheets(1).Range("A1:A" & LR2).Copy
            ws.Range("B" & LR).End(xlUp).PasteSpecial xlPasteValues

            For i = LR To (LR + LR2 - 1)
                If ws.Range("A" & i) = "" Then ws.Range("B" & i) = dateChooser
            Next i
        End If

        wbGRP.Close False
        fNAME = Dir
    Loop
Application.DisplayAlerts = True

End Sub

Excel VBA-将单元格值设置为与所有非空白单元格相邻的变量

1 个答案: