我有多个报告,需要按照特定的步骤将这些报告编译成一个主文件,然后在新数据的左侧添加一个日期。需要遵循的步骤是:
因此,基本上,它需要打开文件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
答案 0 :(得分:0)
也许是这样的。
LR
)都会更改,因此在打开另一本书之前,需要在循环内重新计算该行。在您的导入书上,每个文件大概都有不同的行,因此这需要它自己的最后一行计算(LR2
)。ws
指向目标书上的Sheet1
。然后,我们将使用wbGRP.Sheets(1)
来引用您打开的每本导入书上的第一张纸。这可能需要纠正(您在评论中待回复)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