Как удалить строки, не содержащие числа

Question

Я делаю макрос, который импортирует данные из PDF в Excel. Из всего, что я вставил, мне нужны только данные из таблицы, содержащей 50 строк и 7 столбцов. Каждая строка импортируется как строка чисел, разделенных пробелами, как показано ниже: мне нужно удалить строки, где первая часть строки не является числом от 1 до 50 (50 изменяется, но задается пользователем как ввод ). Я попытался настроить цикл, как показано на рисунке, но мне становится все сложнее понять, поэтому приведенное ниже определенно не сработает - я просто продемонстрирую свой мыслительный процесс. Кроме того, есть ли способ конвертировать данные в строках в числа вместо текста?

    Dim A As Integer
    Dim B As Integer
    Dim C As Integer

    Dim MyString() As String

    A = 1
    Do While Not IsEmpty(Cells(A + DataStart - 1, 1)) 'DataStart is the row 
                                                       where data starts
    MyString() = Split(Cells(A + DataStart - 1, 1))
        C = 1
        Do Until C = 50
            If MyString(0) = C Then
                For B = 0 To UBound(MyString)
                    Cells(A, B + 1) = MyString(B)
                Next B
            Else
                ActiveSheet.Cells(A, 1).Select
                ActiveCell.EntireRow.Delete
            End If
        Next C                                
    Loop

Пример данных:

44 210,21 22,55 210,21 22,553 196,505 OK        
45 227,59 25,28 226,02 25,612 197,529 OK        
46 228,58 25,31 228,58 25,310 197,827 OK        
2019.06.06. 16:37:28 M94_2019.06.06._17471_Fólia teszt_Felsőparaméter_CB.is_tens        
M94_2019.06.06._17471_Fólia teszt_Felsőparaméter_CB.is_tens 3 oldal a 4-ból/ből     
Max.        
Load        
(N)     
Extension       
at Max.     
(mm)        
Load at     
break       
(N)     
Extension       
at break        
(mm)        
Terhelés 20mm-nél       
(N)     
Note to     
sample      
47 213,54 24,07 200,82 24,410 192,925 OK        
48 234,06 26,23 234,06 26,231 198,417 OK        
49 227,20 25,32 227,20 25,322 197,384 OK        
50 211,45 25,30 211,45 25,300 192,622 OK

Answer 1

Вы на правильном пути, но есть несколько вещей, которые нужно понять, которые очень помогут вам в вашем коде:

1. Всегда используйте Option Explicit, чтобы гарантировать, что ваши переменные объявлены так, как вы хотите
2. Избегайте использования Select и Activate

Вот пример, который поможет вам начать работу.

Option Explicit

Sub test()
    Const min As Long = 1
    Const max As Long = 50

    Dim dataRange As Range
    Set dataRange = Sheet1.UsedRange

    Dim topRow As Long
    Dim bottomRow As Long
    With dataRange
        topRow = .Rows(1).Row
        bottomRow = .Rows(.Rows.Count).Row
    End With

    Dim tokens As Variant
    Dim value As Variant
    Dim saveThisRow As Boolean
    Dim i As Long
    For i = bottomRow To topRow Step -1
        saveThisRow = False
        tokens = Split(dataRange.Cells(i, 1).value, " ")
        If IsArray(tokens) Then
            value = tokens(0)
            If IsNumeric(value) Then
                If value >= min And value <= max Then
                    saveThisRow = True
                End If
            End If
        End If
        If Not saveThisRow Then
            dataRange.Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

Answer 2

Вот мое мнение. Похоже на решение PeterT. При работе с большими файлами Рон абсолютно прав в том, насколько дорогим может быть удаление строк. Таким образом, запись отформатированных данных на другой лист окажется быстрее.

Sub ParseData()

    Dim lowBound As Integer
    Dim hiBound As Integer

    lowBound = 1
    hiBound = 50

    Dim currentWS As Worksheet
    Set currentWS = ThisWorkbook.Worksheets("Sheet1") '' Change this to the sheet your data is stored on

    Dim allData As Range
    '' Define where your data starts and ends, change this as needed
    Set allData = currentWS.Range("A1", currentWS.Range("A1").End(xlDown))

    Dim datRng As Range

    Dim sploded() As String

    '' Loop backwards on data since deleting will cause row skips if you do forwards
    For i = allData.Cells.Count To 1 Step -1

        Set datRng = allData.Cells(i, 1) 'Looking at a single cell

        sploded = Split(datRng.Value, " ") 'Space delimited to array

        If IsNumeric(sploded(0)) = True Then
            ' if the first number is within the bounds
            If CInt(sploded(0)) <= hiBound And CInt(sploded(0)) >= lowBound Then

                '' Overwrite with the data into cells
                For j = LBound(sploded) To UBound(sploded)
                    datRng.Offset(0, j).Value = sploded(j)
                Next j
            Else
                datRng.EntireRow.Delete '' Is number, but outside the bounds
            End If
        Else
            datRng.EntireRow.Delete '' Isn't a number
        End If
    Next i


End Sub

Answer 3

Я бы подошел к этому иначе.Переход назад и вперед к электронной таблице, удаление строк, стоит много времени.

Я бы

• прочитал столбец в массив вариантов VBA для быстрой обработки
• пройти через массив, собирая строки, которые вы хотите сохранить
• записать их обратно на лист
  • либо удалить, а затем написать в исходном месте или (что я предпочитаю)
  • запишите результаты в другом месте
• split, используя texttocolumns метод

Не уверен, как вы хотите отформатировать строку «split».Если вы оставите это как общее, и если запятая является вашим десятичным разделителем, то они будут рассматриваться как числа.Если что-то еще, вам может потребоваться установить для параметра fieldinfo текст для каждого столбца.

Option Explicit
Sub terfuge()
    Dim rRes As Range, wsSrc As Worksheet, wsRes As Worksheet
    Dim vSrc As Variant, vRes As Variant, Col As Collection
    Dim I As Long

Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
    Set rRes = wsRes.Cells(1, 2) 'or cells(1,1) if you want to overwrite

With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set Col = New Collection
For I = 1 To UBound(vSrc, 1)
    Select Case Split(vSrc(I, 1))(0)
        Case 1 To 50
            Col.Add vSrc(I, 1)
    End Select
Next I

ReDim vRes(1 To Col.Count, 1 To 1)
For I = 1 To Col.Count
    vRes(I, 1) = Col(I)
Next I

Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))
With rRes
    .EntireColumn.Clear
    .Value = vRes
    Application.DisplayAlerts = False 'avoid the "do you want to replace the data" alert
    .TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _
        Tab:=False, semicolon:=False, comma:=False, Space:=True, other:=False
    Application.DisplayAlerts = True
    .CurrentRegion.EntireColumn.AutoFit
End With
End Sub