Игнорировать или удалять строки из подключения к данным

Question

Я извлекаю некоторые данные из текстового файла. Один и тот же формат каждый день, но разные данные

Это заполняет живой отчет для моей команды для просмотра и мониторинга.

Последний столбец в отчете «разрешен». В настоящее время я просто удаляю любую строку с «позволено» в

То, что я хочу сделать, это либо удалить его до заполнения данных, либо удалить строки сразу после импорта

Обратите внимание, для опции "позволено" - "ДА" и пусто

Можно ли остановить ввод строки при вводе данных?

Мой код:

Option Explicit

Private Sub Import()

Dim ws As Worksheet, lastRowC As Long

Set ws = Worksheets("Report")
lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row + 1 ' bottom populated cell of Column "C", plus 1

    With ws.QueryTables.Add(Connection:= _
            "TEXT;N:\Operations\001 Daily Management\Shop Goods\FMSQRY.CSV", Destination:= _
            ws.Cells(lastRowC, 2))
        .Name = "FMSQRY"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 2, 2, 1, 1, 2, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    With ActiveWorkbook
        .Connections("FMSQRY").Delete
        With ws
            .Names("FMSQRY").Delete
        End With
    End With

End Sub

Private Sub TodaysDate()

Dim ws As Worksheet, lastRowC As Long, lastRowH As Long

Set ws = Worksheets("Report")

lastRowH = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 ' bottom populated cell of Column "A", plus 1
lastRowC = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row ' bottom populated cell of Column "B"

    With ws.Range(ws.Cells(lastRowH, 1), ws.Cells(lastRowC, 1))
        .FormulaR1C1 = "=TODAY()"
        .Value = .Value
    End With

End Sub

Answer 1

Требования:
 Ежедневно импортировать файл CSV
 Файл CSV не имеет заголовков
 Исключить все записи, помеченные как YES в номере поля12 из файла CSV
 Значения в поле 12: YES и Null (т. Е. Пусто)
 Добавить отфильтрованные данные CSV в существующий лист с именем Report
 Новыйданные должны быть размещены в конце существующих данных, начиная со столбца 2
. column В столбце 1 новые данные должны иметь дату, когда данные были импортированы.

Решение:
Это решение использует операторы ADODB.Connection, ADODB.RecordSet и SQL для фильтрации данных и добавления поля Date (в первой позиции)с датой обработки.
Да, мы все много раз слышали о мифе о том, что для подключения ADODB требуются заголовки ... Не совсем!
Давайте используем следующие свойства Connection:

.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & sPath & ";" & _
        "Extended Properties='text;HDR=No;FMT=Delimited(,)'"`

где:
sPath: содержит местоположение файла
HDR=No: указывает на отсутствие заголовка
FMT=Delimited(,): указывает на файл CSV

Этот SQL command извлекает необходимыеданные при добавлении поля Date:

"SELECT #" & Date & "# As [DATE], * FROM [" & sFile & "] Where [F12] Is Null"

Эта функция создает recordset с данными, извлеченными из файла CSV согласно предоставленному SQL statement.
Имеет recordset (выходной объект), path, filename и SQL statement в качестве параметров для обеспечения гибкости.
Возвращает логическое значение, указывающее результат процесса.True: записи, соответствующие SQL command, были найдены и извлечены, False: нет записей, соответствующих SQL command.

Public Function SQL_ƒCsv_ToRecordSet(oOutput As Object, _
    sPath As String, sFile As String, sSql As String) As Boolean
Dim oAdCn As Object, oAdRs As Object

    Rem Set Objects
    Set oAdCn = CreateObject("ADODB.Connection")
    Set oAdRs = CreateObject("ADODB.Recordset")

    Rem Open Connection
    With oAdCn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & sPath & ";" & _
            "Extended Properties='text;HDR=No;FMT=Delimited(,)'"
        .Open
    End With

    Rem Apply SQL to Source
    With oAdRs
        .LockType = 1                   'adLockReadOnly
        .CursorType = 3                 'adOpenStatic
        .ActiveConnection = oAdCn
        .Open Source:=sSql, Options:=1  'adCmdText
        Rem Validate Results
        If .RecordCount = 0 Then Exit Function
    End With

    Rem Set Results
    Set oOutput = oAdRs
    SQL_ƒCsv_ToRecordSet = True

    End Function

Используйте эту процедуру для вызова функции:

Private Sub Csv_Import()
Dim oAdRs As Object, ws As Worksheet
Dim sPath As String, sFile As String, sSql As String
Dim lRow As Long, sMsgBdy As String

    Rem Set Variables & Objects
    sFile = "FMSQRY.CSV"
    sPath = "N:\Operations\001 Daily Management\Shop Goods"     'No separator at the end!
    sSql = "SELECT #" & Date & "# As [DATE], * FROM [" & sFile & "] Where [F12] Is Null"    'Update as required
    Set ws = ThisWorkbook.Worksheets("Report")      'Update as required

    Rem Extract filtered data from csv file
    If SQL_ƒCsv_ToRecordSet(oAdRs, sPath, sFile, sSql) Then

        Rem Post extracted records (with the date of extraction in Field 1)
        With ws
            lRow = 1 + .Cells(.Rows.Count, 3).End(xlUp).Row
            .Cells(lRow, 1).CopyFromRecordset oAdRs
        End With
        sMsgBdy = "Records added successfully…"

    Else
        Rem No Records Filtered
        sMsgBdy = "No records found in: " & vbCrLf _
            & vbTab & sFile & vbCrLf _
            & vbTab & sPath

    End If
    MsgBox sMsgBdy, vbInformation

    End Sub

Answer 2

Если бы вам удавалось иметь подходящие заголовки, вы могли бы фильтровать, используя соединение ADO и оператор SQL. Но так как у вас нет подходящих заголовков в ваших данных CSV, самое простое решение - удалить строки сразу после импорта.

Представьте следующие данные после импорта:

Следующий код удалит все строки, содержащие allowed в столбце F. Вам необходимо настроить имя столбца в соответствии с именем столбца, который вы использовали:

Option Explicit

Public Sub TestDeleteAllAllowed()
    lastRowC = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row + 1 ' bottom populated cell of Column "C", plus 1

    'your import stuff here        

    DeleteAllAllowed StartRow:=lastRowC 
End Sub


Public Sub DeleteAllAllowed(Optional StartRow As Long = 1)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Report") 'define worksheet

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row 'find last used row in column F

    If LastRow < StartRow Then Exit Sub

    Dim DataArray As Variant 'read column F into array
    DataArray = ws.Columns("F").Resize(RowSize:=LastRow - StartRow + 1).Offset(RowOffset:=StartRow - 1).Value 'column F contains "allowed"

    Dim RowsToDelete As Range 'we collect all rows to delete here

    If IsArray(DataArray) Then
        Dim iRow As Long
        For iRow = 1 To LastRow - StartRow + 1
            If DataArray(iRow, 1) = "allowed" Then
                If RowsToDelete Is Nothing Then
                    Set RowsToDelete = ws.Rows(iRow + StartRow - 1)
                Else
                    Set RowsToDelete = Union(RowsToDelete, ws.Rows(iRow + StartRow - 1))
                End If
            End If
        Next iRow
    Else
        If DataArray = "allowed" Then
            Set RowsToDelete = ws.Rows(LastRow)
        End If
    End If

    If Not RowsToDelete Is Nothing Then
        RowsToDelete.Delete 'delete all rows at once
    End If
End Sub