Question

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

我更像是一个SharePoint工作流程编写器，并倾向于需要一个变量来存储文件名（第二个打开的工作表），以便稍后在vlookup中调用，但我不确定这是否是正确的想法，或者究竟如何执行。因为我是一个初学者，你会看到我逐行写了这个，有许多评论，经文必然会缩小步骤。

目标：

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

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

尝试从此开始：

    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 2

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

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

Answer 3

我已经做到了，现在它正在给我带来好消息。＆＃34;编译错误＆＃34; ..阻止如果没有结束if，并突出显示end sub，我们宏中的最后一行。它确实lRow = 20然后是下一行（因为所有其他的都被注释掉了）..

否则 MsgBox＆＃34;这不是审计报告＆＃34; 万一结束子

它是突出显示的结束子

Answer 4

然后转到If intChoice＆lt;＆gt; 0然后 strPath1 = Application.FileDialog（msoFileDialogOpen）.SelectedItems（1）

并跳过所有语句/变量/ Dim但直接从mso语句转到 Dim j As Integer：j = 12

然后跳过下一行并转到

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

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作为要打开的工作簿。

预期成果：

两个工作簿之间的Excel宏Vlookup

5 个答案: