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

我会采取不同的方式。往返于电子表格，删除行会花费很多时间。

我会

将列读入VBA变量数组以进行快速处理
遍历数组，收集要保留的行
将其写回到工作表
- 删除然后在原始位置写，或（我更喜欢）
- 将结果写到其他地方
使用texttocolumns方法拆分

不确定您要如何设置“拆分”行的格式。如果将其保留为常规名称，并且如果逗号是小数点分隔符，则它们将被视为数字。如果有其他问题，您可能需要将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

Answer 2

您处在正确的轨道上，但是有一些需要理解的事情将极大地帮助您编写代码：

Always use Option Explicit，以确保按所需方式声明变量
Avoid using Select and 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 3

这是我的看法。类似于PeterT的解决方案。在处理大文件时，Ron删除行的代价是绝对正确的。因此，将格式化的数据写到另一张纸上将被证明会更快。

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

如何删除不包含数字的行

3 个答案: