0

生ファイルからデータをコピーし、生ファイルの列 A の値ごとにマスター ワークブックの個々のシートを更新できるコードを作成しようとしています。

背景: 生ファイルの列 A には多くの一意の ID が記載されており、他の列には各一意の ID に対応するデータが含まれています。一意の ID ごとに、マスター ブックに個別のシートがあります。

要件：

  1. 未加工ファイルの削除対象シートに記載されている不要な一意の ID を削除します
  2. 生ファイルから行全体をコピーし、マスター ワークブックで関連する一意の ID シートを見つけて、最後の行にデータを貼り付けます。
  3. 一意の ID シートがマスター ワークブックにない場合は、それを作成してデータを貼り付けます。

問題：

  1. 私が持っているコードは、マスターで正しいシートを見つけることができず、シートを見つけることができず、その名前で新しいシートを作成しようとすると、シート名が既に存在するというエラーが表示されます。
  2. 一意の ID の新しいシートを作成する必要がある場合は、ループを続行して、他の ID のデータも貼り付ける必要があります。
  3. 最後に、作成されたすべての新しいシートの詳細を示すメッセージ ボックスが表示されます。

私を助けてください....私はしばらくの間これを解決しようとしています。

生ファイル（エクセル）： 生ファイル 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、変数を参照し続けるループにあります。変数がどこでも初期化されていることがわかりませんか?iji

于 2012-07-30T01:22:44.273 に答える