Excel VBA - 如果未找到条件,请不要输出错误

时间:2017-03-21 21:34:06

标签: excel excel-vba vba

作为简要说明,我整理了一个脚本,以帮助将生成的CSV中的每周Google Analytics数据导入一个主工作簿。有可能会在此跟踪系统中添加更多网站帐户,因此我有另一个脚本可帮助添加帐户,以确保电子表格/表格中的所有内容都保持一致。

对于实际导入,我有一个“两部分”VBA脚本,用于遍历文件夹中的所有CSV,打开它们,将CSV中的数据导入主工作簿,然后删除CSV成功完成循环后再转到下一个循环。我已经包含一个错误声明,告诉用户他们导入的CSV是否在主工作簿中没有匹配的电子表格,以便它在那时停止脚本,让他们有机会将该帐户添加到继续之前的工作手册。

但是,有些星期特定网站可能没有所有数据,这错误地导致错误消息显示告诉用户该帐户需要添加到网站。如果CSV不包含该数据,那是因为数据基本上是0,并且我想要在行中输入0来记下那周没有活动,不要给用户一个他们需要添加的错误帐户到工作簿。

'THE FOLLOWING SCRIPT RUNS WHEN THE IMPORT ANALYTICS BUTTON IS CLICKED
Sub LoopAllExcelFilesInFolder()
    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    'if at any point an error is encountered, display the Error Message (at end of script)
    On Error GoTo ErrMsg

    'Optimize Macro Speed by turning off screen updating
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

        With FldrPicker
          .Title = "Select A Target Folder That Contains Your Files"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
        End With

    'In Case of Cancel
NextCode:
      myPath = myPath
      If myPath = "" Then GoTo ResetSettings

    'Target File Extension (must include wildcard "*")
      myExtension = "*.csv*"

    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)

    'Loop through each Excel file in folder
      Do While myFile <> ""
        'Set variable equal to opened workbook
          Set wb = Workbooks.Open(Filename:=myPath & myFile)
          wb.Activate
        'Ensure Workbook has opened and is active before moving on to next line of code
    DoEvents

    Dim rng1 As Range
    Dim strSearch As String
    Dim sheet_name_result As String

    'sets the URL (minus the "# " in front) to be the search string
    strSearch = Right(ActiveWorkbook.Sheets(1).Range("A2"), Len(ActiveWorkbook.Sheets(1).Range("A2")) - 2)

    'sets the data list URL column to be the searched range
    Set rng1 = Workbooks("Spokes- Google Analytics trends.xlsm").Worksheets("LISTS").Range("B:B").Find(strSearch, , xlValues, xlPart)
    sheet_name_result = rng1.Offset(0, -1).Value

        'LOOP THROUGH FOLLOWING CODE IF A MATCH IS FOUND
        If Not rng1 Is Nothing Then
            Dim table_list_object As ListObject
            Dim table_object_row As ListRow
            Set table_list_object = Workbooks("Spokes- Google Analytics trends.xlsm").Worksheets(sheet_name_result).ListObjects(1)
            Set table_object_row = table_list_object.ListRows.Add

        'calculate pageviews
            Dim organic_pageviews As Integer
            Dim paid_pageviews As Integer
            Dim direct_pageviews As Integer
            Dim referral_pageviews As Integer
            Dim display_pageviews As Integer
            Dim sum_pageviews As Integer
            organic_pageviews = Application.SumIf(Range("A:A"), "organic", Range("C:C"))
            paid_pageviews = Application.SumIf(Range("A:A"), "paid", Range("C:C"))
            direct_pageviews = Application.SumIf(Range("A:A"), "direct", Range("C:C"))
            referral_pageviews = Application.SumIf(Range("A:A"), "referral", Range("C:C"))
            display_pageviews = Application.SumIf(Range("A:A"), "display", Range("C:C"))
            sum_pageviews = organic_pageviews + paid_pageviews + direct_pageviews + referral_pageviews + display_pageviews

        'calculate visitors aka sessions
            Dim organic_visitors As Integer
            Dim paid_visitors As Integer
            Dim direct_visitors As Integer
            Dim referral_visitors As Integer
            Dim display_visitors As Integer
            Dim sum_visitors As Integer
            organic_visitors = Application.SumIf(Range("A:A"), "organic", Range("F:F"))
            paid_visitors = Application.SumIf(Range("A:A"), "paid", Range("F:F"))
            direct_visitors = Application.SumIf(Range("A:A"), "direct", Range("F:F"))
            referral_visitors = Application.SumIf(Range("A:A"), "referral", Range("F:F"))
            display_visitors = Application.SumIf(Range("A:A"), "display", Range("F:F"))
            sum_visitors = organic_visitors + paid_visitors + direct_visitors + referral_visitors + display_visitors

        'calculate unique visitors aka new users
            Dim organic_new As Integer
            Dim paid_new As Integer
            Dim direct_new As Integer
            Dim referral_new As Integer
            Dim display_new As Integer
            Dim sum_new As Integer
            organic_new = Application.SumIf(Range("A:A"), "organic", Range("E:E"))
            paid_new = Application.SumIf(Range("A:A"), "paid", Range("E:E"))
            direct_new = Application.SumIf(Range("A:A"), "direct", Range("E:E"))
            referral_new = Application.SumIf(Range("A:A"), "referral", Range("E:E"))
            display_new = Application.SumIf(Range("A:A"), "display", Range("E:E"))
            sum_new = organic_new + paid_new + direct_new + referral_new + display_new

        'calculate pages/visit
            Dim pages_per_visit As String
            pages_per_visit = (sum_pageviews / sum_visitors) / 100
        'calculate organic traffic
            Dim organic_percent As String
            organic_percent = (organic_visitors / sum_visitors)

        'calculate referral traffic
            Dim referral_percent As String
            referral_percent = (referral_visitors / sum_visitors)

        'isolate start date
            Dim date_location As String
            Dim start_date_ugly As String
            Dim start_date_string As String

            date_location = ActiveWorkbook.Sheets(1).Range("A4")
            start_date_ugly = Left(date_location, 10)
            start_date_string = Right(start_date_ugly, 8)

        'isolate end date
            Dim end_date_string As String

            end_date_string = Right(date_location, 8)

        'posts data to columns
            table_object_row.Range(1, 1).Value = DateSerial(Left(start_date_string, 4), Mid(start_date_string, 5, 2), Right(start_date_string, 2))
                table_object_row.Range(1, 1).NumberFormat = "mm/dd/yyyy"
            table_object_row.Range(1, 2).Value = DateSerial(Left(end_date_string, 4), Mid(end_date_string, 5, 2), Right(end_date_string, 2))
                table_object_row.Range(1, 2).NumberFormat = "mm/dd/yyyy"
            table_object_row.Range(1, 3).Value = sum_pageviews
            table_object_row.Range(1, 4).Value = sum_visitors
            table_object_row.Range(1, 5).Value = sum_new
            table_object_row.Range(1, 6).Value = Format((pages_per_visit), Percent)
            table_object_row.Range(1, 7).Value = organic_percent
            table_object_row.Range(1, 8).Value = referral_percent

        Else
            'Informs user that the URL was not found (redundant, because script will default to Error Message if it encounters a problem)
            'It's better to have the error message end the script outside of the loop sequence because it will stop the loop at the problem URL,
            'allowing the user to add the URL manually, then click import again to pick up where they left off.
            MsgBox strSearch & " was not found."
        End If

    'sets the currently active workbook name as a variable called xFullName
    xFullName = Application.ActiveWorkbook.FullName

        'Closes and deletes workbook by name
          wb.Close SaveChanges:=False
          Kill xFullName
        'Ensure Workbook has closed before moving on to next line of code
          DoEvents

        'Get next file name
          myFile = Dir
      Loop


'END OF LOOP EVENTS

    'Message box when tasks are completed
      MsgBox "CSVs have been imported."

ResetSettings:
      'Reset Macro Optimization settings by turning on screen updating
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True


Exit Sub

'Error Message that script defaults to if it can't complete (ie: if it encounters a URL not in the database) and finishes script
ErrMsg:
    MsgBox strSearch & " is not in the spreadsheet. Please add it to the database before importing CSV data."
End Sub

编辑:Screenshot of CSV data这是CSV的样子。如果那周没有数据,那么整个单元格块A7:H11(实际上这个截图中缺少一个正常存在的行,并不总是设置的单元格范围)会丢失,A7会改为启动日索引表。

0 个答案:

没有答案