两个工作簿之间的 Excel 宏 Vlookup

Question

我已经启动了一个简单的宏来清理报告。我需要添加一个 vlookup，并且很难弄清楚该往哪个方向发展，是否应该使用 match 或 vlookup 表达式，以及如何解决动态且每周都在变化的文件名。

我更像是一个 SharePoint 工作流编写者，并且倾向于需要一个变量来存储（第二个打开的工作表的）文件名，以便稍后在 vlookup 中回忆，但我不确定这是否是正确的想法，或者确切的执行方式。由于我是初学者，您会看到我一行一行地写了这篇文章，其中包含许多 cmets，诗句必然是浓缩的步骤。

目标：

获取已经被用户打开的审计报告，运行宏清理文件，选择以前版本的文件（在对话框中由用户选择），并查看列，以原始格式文档返回结果，粘贴值vlookup，清理所有#n/a 值，查找后关闭源文件，保存目标文件。 Vlookup 信息位于代码中的 cmets 中应该写入的位置。

Sub AuditRptCleanup()

 

    'Verify Correct File Is Open

    If ActiveWorkbook.Name Like "*Audit*" Or ActiveWorkbook.Name Like "*AuditReport*" Or   

    ActiveWorkbook.Name Like "*audit*" Or ActiveWorkbook.Name Like "*auditreport*" Then

    On Error GoTo ErrorFileIncompatiable:

   

    'Verify Macro has not ran on Workbook Previously

    If Cells(1, 1).Value = "Product Number" And Cells(1, 2).Value = "Prod Type" Then

    MsgBox "Macro has already been used on this workbook"

    Exit Sub

    End If

           

    'Select Starting Cell

    Range("A1").Select

   

    'Unmerge all Cells in Worksheet

    ActiveSheet.Cells.UnMerge

       

    'Delete Columns A1 thru D1

    Range("$A$1:$D$1").EntireColumn.Delete

   

    'Delete Rows A1 thru A9

    Range("$A$1:$A$9").EntireRow.Delete

 

    'Cut and Paste Cells

    Range("$A$2").Cut Range("$A$1")

    Range("$G$1").Cut Range("$F$1")

    Range("$P$1").Cut Range("$O$1")

    Range("$AA$1").Cut Range("$Z$1")

 

    'Sort by Column A to Remove Extra Rows from View

    Columns("$A:$AM").Sort key1:=Range("$A:$A"), order1:=xlAscending, Header:=xlYes

 

    'Auto Fit Contents in Columns and Rows

    ActiveCell.Columns("$A:$AG").EntireColumn.Select

    ActiveCell.Columns("$A:$AG").EntireColumn.AutoFit

    ActiveSheet.Rows.EntireRow.AutoFit

   

    'Delete Empty Columns

    Range("$B:$B, $D:$D, $G:$I, $K:$L, $N:$N, $P:$Q, $T:$V, $X:$Y, $AA:$AB, $AD:$AF").EntireColumn.Delete

  

    'Remove Wrap Text from Cell B1

    Range("$B$1").WrapText = False

   

    'Autofit Contents of Columns

    Range("$A$1:$AF$1").Columns.AutoFit

   

    'Autofit Row A2 Contents

    Range("$A$2:$A$2").Rows.AutoFit

   

    'Delete Columns B and C

    Range("$B:$C").EntireColumn.Delete

   

    'Remove Wrap Text on L1 and M1

    Range("$L$1:$M$1").WrapText = False

 

    'Label Cell L1

    Range("$L$1").Value = "Qty from Previous Report"

   

    'Label Cell M1

    Range("$M$1").Value = "Change in Qty"

   

    'Label Cell N1

    Range("$N$1").Value = "Date New"

   

    'Label Cell O1

    Range("$O$1").Value = "Comments"

   

    'Label Cell P1

    Range("$P$1").Value = "Action"

   

    'Label Cell Q1

    Range("$Q$1").Value = "Status"

   

    'Label Cell R1

    Range("$R$1").Value = "Production Storage Quantity"

   

    'Autofit Contents of Columns

    Range("$L$1:$R$1").Columns.AutoFit

   

      

    'Open Previous Day Source file from User Selection   

    Dim val As String

    Dim intChoice As Integer

    Dim strPath1 As String

   

    'Alert User to open file

    MsgBox ("Please browse to the previous day Audit file you wish to use for the VlookUp")

   

    'Open File Dialog Box

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

  

    'Open File Dialog Box and prompt User to select single file

    intChoice = Application.FileDialog(msoFileDialogOpen).Show

 

    'Determine what file User selected

    If intChoice <> 0 Then

 

    'Get File Path selected by User

    strPath1 = Application.FileDialog( _

    msoFileDialogOpen).SelectedItems(1)

 

   'VLookup Column L thru R and Paste to Target File

   ‘This is where I need to take the file opened at the very beginning, and look up value A2, from the new    

   ‘file the user just opened, from Sheet 1! A:L, col index 12, FALSE, and paste into column L2 in the file

   ‘opened from the beginning, to the last row that has data (last row containing data changes each

   ‘time).

  ‘I need to then do the same for M-R, changing the col index to 13 for M, 14 for O, so forth and so on,    

  ‘and end each look up to the last row with data in the column.

  ‘I need to be able to IFERROR,0 in my steps to avoid #n/a

  ‘I then to need to copy and paste the values I just entered from row 2 – L:R, to last Row of data, and

  ‘paste value.

 

   'Save File As

    Application.GetSaveAsFilename

    End If

   

    'Notify User of Incompatible File

ErrorFileIncompatiable:

    MsgBox "This is not an Audit Report"

    Exit Sub

    End If

   

   

End Sub

 

Results destination file macro after running]1

Answer 1

在用户运行宏之前，他们会：

步骤 1. 打开当日审计报告 步骤 2. 运行宏（格式化） 步骤 3. 宏应提示用户从对话框中打开前一天或上次使用的审计文件 步骤 4. 在前一天的报告中查找当日报告的 A2，并返回 Q 列中的任何内容，然后将该值逐行粘贴到当日报告中，从 A2 开始，然后是 A3，然后是 A4，依此类推, 直到碰到一个空行（或最后一行有文本）。然后它应该再次查找 A2，但这一次，将源中的值 R 返回到目标文件的 M 行，依此类推，直到目标的 R 行已满。

Answer 2

我已经这样做了，现在它给了我很好的 ole'“编译错误”.. 如果没有 end if 则阻塞，并突出显示 end sub，我们宏中的最后一行。它执行 lRow=20 然后是下一行（因为所有其他人都被注释掉了）..

其他 MsgBox "这不是审计报告" 万一 结束子

这是它突出显示的结束子

Answer 3

然后转到 If intChoice 0 Then strPath1 = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

并跳过所有语句/变量/Dim 但是.. 直接从 mso 语句转到 将 j 调暗为整数：j = 12

然后跳过下一行并转到

Set wb = Workbooks.Open(strPath1)
Set sht2 = wb.Worksheets (1)
lRow = 20
End If
End If
Exit Sub

Answer 4

尝试从这个开始：

    Option Compare Text

Sub AuditRptCleanup()
Dim sht As Worksheet

    Set sht = ThisWorkbook.ActiveSheet
    'Verify Correct File Is Open
    If ActiveWorkbook.Name Like "*Audit*" Then

    'Verify Macro has not ran on Workbook Previously

    With sht

    If .Cells(1, 1).Value = "Product Number" And .Cells(1, 2).Value = "Prod Type" Then

    MsgBox "Macro has already been used on this workbook"

    Exit Sub

    End If


    'Unmerge all Cells in Worksheet
    .Cells.UnMerge

    'Delete Columns A1 thru D1
    .Range("$A$1:$D$1").EntireColumn.Delete

    'Delete Rows A1 thru A9
    .Range("$A$1:$A$9").EntireRow.Delete


    'Cut and Paste Cells
    .Range("$A$2").Cut .Range("$A$1")
    .Range("$G$1").Cut .Range("$F$1")
    .Range("$P$1").Cut .Range("$O$1")
    .Range("$AA$1").Cut .Range("$Z$1")

    'Sort by Column A to Remove Extra Rows from View
    .Columns("$A:$AM").Sort key1:=.Range("$A:$A"), order1:=xlAscending, Header:=xlYes

    'Auto Fit Contents in Columns and Rows
    .Columns("$A:$AG").EntireColumn.AutoFit
    .Rows.EntireRow.AutoFit

    'Delete Empty Columns
    .Range("$B:$B, $D:$D, $G:$I, $K:$L, $N:$N, $P:$Q, $T:$V, $X:$Y, $AA:$AB, $AD:$AF").EntireColumn.Delete

    'Remove Wrap Text from Cell B1
    .Range("$B$1").WrapText = False

    'Autofit Contents of Columns
    .Range("$A$1:$AF$1").Columns.AutoFit

    'Autofit Row A2 Contents
    .Range("$A$2:$A$2").Rows.AutoFit

    'Delete Columns B and C
    .Range("$B:$C").EntireColumn.Delete

    'Remove Wrap Text on L1 and M1
    .Range("$L$1:$M$1").WrapText = False

    'Label Cell L1
    .Range("$L$1").Value = "Qty from Previous Report"

    'Label Cell M1
    .Range("$M$1").Value = "Change in Qty"

    'Label Cell N1
    .Range("$N$1").Value = "Date New"

    'Label Cell O1
    .Range("$O$1").Value = "Comments"

    'Label Cell P1
    .Range("$P$1").Value = "Action"

    'Label Cell Q1
    .Range("$Q$1").Value = "Status"

    'Label Cell R1
    .Range("$R$1").Value = "Production Storage Quantity"

    'Autofit Contents of Columns
    .Range("$L$1:$R$1").Columns.AutoFit

    End With
    'Open Previous Day Source file from User Selection
    Dim val As String
    Dim intChoice As Integer
    Dim strPath1 As String

    'Alert User to open file
    MsgBox ("Please browse to the previous day Audit file you wish to use for the VlookUp")

    'Open File Dialog Box
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

    'Open File Dialog Box and prompt User to select single file
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    'Determine what file User selected
    If intChoice <> 0 Then

    'Get File Path selected by User
    strPath1 = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

    'VLookUp
    Dim xl As New Excel.Application
    Dim wb As Workbook
    Dim sht2 As Worksheet
    Dim lRow As Long
    Dim j As Integer: j = 12
    Dim rng As Range

    Set wb = xl.Workbooks.Open(strPath1)
    Set sht2 = wb.Worksheets(1) 'First Sheet in WB adjust if needed

    xl.Visible = True

    lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row

    On Error Resume Next
    For i = 2 To lRow
    If sht.Cells(i, 1).Value <> "" Then
        Set rng = sht2.Range("A:A").Find(sht.Cells(i, 1).Value)
        If Not rng Is Nothing Then
            sht.Cells(i, 12).Value = sht2.Cells(rng.Row, 12).Value
            sht.Cells(i, 13).Value = sht2.Cells(rng.Row, 13).Value
            sht.Cells(i, 14).Value = sht2.Cells(rng.Row, 14).Value
            sht.Cells(i, 15).Value = sht2.Cells(rng.Row, 15).Value
            sht.Cells(i, 16).Value = sht2.Cells(rng.Row, 16).Value
            sht.Cells(i, 17).Value = sht2.Cells(rng.Row, 17).Value
            sht.Cells(i, 18).Value = sht2.Cells(rng.Row, 18).Value
        Else
            MsgBox ("No Data Found in Source File for A" & i)
        End If
    End If
    Next

   'Save File As
    wb.Close
    xl.Quit
    MsgBox ("Look Up Done")
    End If

Else
MsgBox "This is not an Audit Report"
End If
End Sub

正如我已经提到的，我将使用Option Compare Text 来检查正确的文件。除此之外，我删除了On Error Statement，因为它在那里没有多大意义。我包含了一个Else 声明。

Answer 5

创建一个新的工作簿。称它为 audit.xlsm。粘贴这段代码：

    Option Compare Text

Sub AuditRptCleanup()
Dim sht As Worksheet

    Set sht = ThisWorkbook.ActiveSheet
    'Verify Correct File Is Open
    If ActiveWorkbook.Name Like "*Audit*" Then

    'Verify Macro has not ran on Workbook Previously

    With sht

    If .Cells(1, 1).Value = "Product Number" And .Cells(1, 2).Value = "Prod Type" Then

    MsgBox "Macro has already been used on this workbook"

    Exit Sub

    End If


    'Unmerge all Cells in Worksheet
    .Cells.UnMerge

    'Delete Columns A1 thru D1
    .Range("$A$1:$D$1").EntireColumn.Delete

    'Delete Rows A1 thru A9
    .Range("$A$1:$A$9").EntireRow.Delete


    'Cut and Paste Cells
    .Range("$A$2").Cut .Range("$A$1")
    .Range("$G$1").Cut .Range("$F$1")
    .Range("$P$1").Cut .Range("$O$1")
    .Range("$AA$1").Cut .Range("$Z$1")

    'Sort by Column A to Remove Extra Rows from View
    .Columns("$A:$AM").Sort key1:=.Range("$A:$A"), order1:=xlAscending, Header:=xlYes

    'Auto Fit Contents in Columns and Rows
    .Columns("$A:$AG").EntireColumn.AutoFit
    .Rows.EntireRow.AutoFit

    'Delete Empty Columns
    .Range("$B:$B, $D:$D, $G:$I, $K:$L, $N:$N, $P:$Q, $T:$V, $X:$Y, $AA:$AB, $AD:$AF").EntireColumn.Delete

    'Remove Wrap Text from Cell B1
    .Range("$B$1").WrapText = False

    'Autofit Contents of Columns
    .Range("$A$1:$AF$1").Columns.AutoFit

    'Autofit Row A2 Contents
    .Range("$A$2:$A$2").Rows.AutoFit

    'Delete Columns B and C
    .Range("$B:$C").EntireColumn.Delete

    'Remove Wrap Text on L1 and M1
    .Range("$L$1:$M$1").WrapText = False

    'Label Cell L1
    .Range("$L$1").Value = "Qty from Previous Report"

    'Label Cell M1
    .Range("$M$1").Value = "Change in Qty"

    'Label Cell N1
    .Range("$N$1").Value = "Date New"

    'Label Cell O1
    .Range("$O$1").Value = "Comments"

    'Label Cell P1
    .Range("$P$1").Value = "Action"

    'Label Cell Q1
    .Range("$Q$1").Value = "Status"

    'Label Cell R1
    .Range("$R$1").Value = "Production Storage Quantity"

    'Autofit Contents of Columns
    .Range("$L$1:$R$1").Columns.AutoFit

    End With
    'Open Previous Day Source file from User Selection
    Dim val As String
    Dim intChoice As Integer
    Dim strPath1 As String

    'Alert User to open file
    MsgBox ("Please browse to the previous day Audit file you wish to use for the VlookUp")

    'Open File Dialog Box
    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

    'Open File Dialog Box and prompt User to select single file
    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    'Determine what file User selected
    If intChoice <> 0 Then

    'Get File Path selected by User
    strPath1 = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

    'VLookUp
    Dim xl As New Excel.Application
    Dim wb As Workbook
    Dim sht2 As Worksheet
    Dim lRow As Long
    Dim j As Integer: j = 12
    Dim rng As Range

    Set wb = xl.Workbooks.Open(strPath1)
    Set sht2 = wb.Worksheets(1) 'First Sheet in WB adjust if needed

    xl.Visible = True

    sht.Cells(2, 1).Value = "F"
    sht.Cells(3, 1).Value = "H"
    lRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row

    On Error Resume Next
    For i = 2 To lRow
    If sht.Cells(i, 1).Value <> "" Then
        Set rng = sht2.Range("A:A").Find(sht.Cells(i, 1).Value)
        If Not rng Is Nothing Then
            sht.Cells(i, 12).Value = sht2.Cells(rng.Row, 12).Value
            sht.Cells(i, 13).Value = sht2.Cells(rng.Row, 13).Value
            sht.Cells(i, 14).Value = sht2.Cells(rng.Row, 14).Value
            sht.Cells(i, 15).Value = sht2.Cells(rng.Row, 15).Value
            sht.Cells(i, 16).Value = sht2.Cells(rng.Row, 16).Value
            sht.Cells(i, 17).Value = sht2.Cells(rng.Row, 17).Value
            sht.Cells(i, 18).Value = sht2.Cells(rng.Row, 18).Value
        Else
            MsgBox ("No Data Found in Source File for A" & i)
        End If
    End If
    Next

   'Save File As
    wb.Close
    xl.Quit
    MsgBox ("Look Up Done")
    End If

Else
MsgBox "This is not an Audit Report"
End If
End Sub

然后创建另一个工作簿。称之为audit2.xlsx。让它看起来像这样：

然后运行代码并选择 audit2.xlsx 作为要打开的工作簿。

预期结果：