Question

我有一个Excel工作簿，其中包含日期和名称列表。该工作簿有500行。日期位于A列中，名称位于B列中。工作簿中所有500行的日期相同，每个名称都是唯一的。

我的目标是最终得到一些工作簿，这些工作簿根据他们的名字保存在一个单独的目录中。每个工作簿都具有相同的标题（Col A：date，Col B：name），其中的行按照A列中的日期排列。

我有其他工作簿，行数不同但列数相同。

通读B列，检查单元格B2中是否存在值为的文件。
如果在单元格B2中具有值的文件不存在，请复制行，在单元格B2中创建一个名称为值的文件，其中包含第一行中的标题，粘贴行并在新工作表的单元格B2中另存为值的名称
如果Cell B2（例如David）中的值已存在，请复制整行，打开该文件，将行（包含日期）粘贴到第一个可用的空行。（我本来想根据日期值插入行，但是无法按照标题对数据进行排序）

工作簿新工作簿的创建，复制，粘贴命名和工作正常。

我遇到的问题是，该过程似乎忽略了第一个If语句，导致excel提出问题：＆＃34;文件名为David存在于此位置，是否要覆盖它？＆＃34;

以下是我到目前为止所做的工作，如果我不够清楚，请告诉我，真诚地感谢任何帮助：

Option Explicit  
Sub CreateNewWorkBook()  
    Dim ThisPath As String  
    Dim ActivePath As String  
    Dim rRange As Range  
    Dim rCell As Range  
    Application.ScreenUpdating = False  
    ThisPath = ThisWorkbook.Path  
    ActivePath = ActiveWorkbook.Path  
    Set File1 = ThisWorkbook  
    Set File2 = ActiveWorkbook  
    Set rRange = Range("B2", Range("B655365").End(xlUp))  
    Set rCell = cell.Value  
For Each rCell In rRange.Cells  
    If Dir(ThisPath & "\" & "Names" & "\" & rCell) = "" Then  
    rCell.EntireRow.Copy  
    Workbooks.Add  
    Range("2:2").PasteSpecial xlPasteAll  
    ActiveWorkbook.SaveAs Filename:=ThisPath & "\" & "Names" & "\" & Range("B2").Value  
    Range("A1").Value = "Date"  
    Range("B1").Value = "Name"  
    ActiveWorkbook.Close SaveChanges:=True  
Else: rCell.EntireRow.Copy  
    Workbooks.Open Filename:=(ThisPath & "\" & "Names" & " \ " & "rCell")  
    UsedRange.Columns(1).Offset(1, 0).PasteSpecial xlPasteValues  
    ActiveWorkbook.Close SaveChanges:=True  
    End If  
    Next rCell  
    Exit For  
    End Sub

Answer 1

问题似乎是您的If语句正在查找文件夹，而不是文件。除非您的名称列包含文件扩展名，否则您还没有为If语句提供足够的信息来检查文件。

您为If语句提供的路径如下所示：

"C:\Users\Workbook Folder\Names\Joe Smith"

由于没有文件扩展名，If语句会认为＆＃34; Joe Smith＆＃34;是一个文件夹。

要解决此问题，您可以在代码中添加文件扩展名，如下所示：

If Dir(ThisPath & "\" & "Names" & "\" & rCell & ".xls*") = "" Then

请注意使用通配符检查所有以＆＃34; .xls＆＃34;开头的文件扩展名。

循环执行工作簿以创建新工作簿并使用单元格值将其另存为标题并将其复制/粘贴到现有工作簿

1 个答案: