0

我正在尝试编写一个代码，该代码使我能够从原始文件中复制数据，并为原始文件 A 列中的每个值更新主工作簿中的各个工作表。

背景：原始文件的A列中提到了许多唯一ID，其他列包含与每个唯一ID对应的数据。每个唯一 ID 在主工作簿中都有一个单独的工作表。

要求：

  1. 删除原始文件中要删除的工作表中提到的不需要的唯一 ID
  2. 从原始文件复制整行，在主工作簿中找到相关的唯一 ID 表并将数据粘贴到最后一行。
  3. 如果主工作簿中没有唯一的 ID 表，则创建它并粘贴数据。

问题：

  1. 我的代码卡在在主文件中找到正确的工作表，它无法找到工作表，并且当它去创建一个具有名称的新工作表时，它给出了工作表名称已经存在的错误。
  2. 如果需要为唯一 ID 创建新工作表，它应该继续循环并粘贴其他 ID 的数据。
  3. 它应该在最后给出一个消息框，提供所有创建的新工作表的详细信息。

请帮帮我....我已经尝试解决这个问题一段时间了。

原始文件（Excel）： 原始文件中的列 excel

主文件（Excel）： 主文件中的列

主文件中的工作表名称： 主文件中的图纸名称

代码：

    Sub unique_ids()
    Dim NewFN As String, MasterFN As String
    Dim lrow As Long, i As Long, drow As Long, j as Long
    Dim rngf As Range, rngv As Range
    Dim SName As Variant
    Dim FoundDup As Range

    'Open the Master file
    proceed:
    MasterFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*",       Title:="Please open the Master File")
    If MasterFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed
    Else
    Workbooks.Open Filename:=MasterFN
    End If
    MasterFN = ActiveWorkbook.Name

    'Open the raw file
    proceed1:
    NewFN = Application.GetOpenFilename(FileFilter:="All files (*.*), *.*", Title:="Please open the raw File")
    If NewFN = "" Then
    MsgBox "You have not selected a file."
    GoTo proceed1
    Else
    Workbooks.Open Filename:=NewFN
    End If

    'Save backup file
    ActiveWorkbook.SaveAs Filename:="D:\Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx", FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks("Counts-" & Format(Date, "dd-mmm-yy") & ".xlsx").Close
    Workbooks.Open Filename:=NewFN
    NewFN = ActiveWorkbook.Name

    'Delete the "to be removed" IDs
    Sheets("counts").Select  
    For Row = Range("A65536").End(xlUp).Row To 2 Step -1 

    Set FoundDup = Sheets("To be deleted").Range("A:A").Find(Cells(Row, 1), LookIn:=xlValues, lookat:=xlWhole) 

    If Not FoundDup Is Nothing Then 
        Cells(Row, 1).EntireRow.Delete 
    End If 

    Next Row

    ‘Update Data

    For j = 2 To lrow
    SName = Workbooks(NewFN).Worksheets("counts").Range("K" & j).Value
    On Error GoTo new_tab
    Workbooks(NewFN).Worksheets("Counts").Range("A" & j & ":I" & j).Copy     Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp).Offset(-1, 0).Row
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)
    Next j

    new_tab:
    MsgBox "New ID encountered", vbCritical
   Workbooks(MasterFN).Sheets.Add(after:=Workbooks(MasterFN).Sheets(Worksheets.Count)).Name = SName
    Workbooks(NewFN).Worksheets("counts").Range("A" & j & ":I" & j).Copy       Workbooks(MasterFN).Worksheets(SName).Range("B" & Rows.Count).End(xlUp)
    Workbooks(MasterFN).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Value = Format(Date, "dd-mmm-yy")
    drow = Workbooks(MasterFN).Worksheets(SName).Range("K" & Rows.Count).End(xlUp)
    Workbooks(MasterFN).Worksheets(SName).Range("K" & drow - 1 & ":S" & drow - 1).Copy  Workbooks(MasterFN).Worksheets(SName).Range("K" & drow & ":S" & drow)

    MsgBox "This work is now complete, new sheet added - " & SName

    End Sub
4

1 回答 1

0

我在这里看到的第一个潜在问题是在For j = 2 To lrow循环中你一直引用变量i而不是我假设的变量j。我看不到i变量已在任何地方初始化？

于 2012-07-30T01:22:44.273 回答