提取数据预备

Sub 提取数据预备()
For i = 1 To 3000
Cells(i, 2) = Application.WorksheetFunction.Trim(Cells(i, 1))
Cells(i, 2) = Application.WorksheetFunction.Trim(Cells(i, 1))
Next
Call 选择性粘贴格式
Call 删除第二列
Call 删除空格
Call 确定位置1
Call 确定位置2
End Sub

Sub 选择性粘贴格式()
Columns("b:b").Copy
Columns("a:a").PasteSpecial xlPasteValues
End Sub

Sub 删除第二列()
Columns("b:b").ClearContents
End Sub

Sub 删除空格()

For i = 3000 To 1 Step -1
If Cells(i, 1) = "" Then Rows(i).Delete Shift:=xlUp
Next

End Sub

Sub 确定位置1()
    Dim i, s
    For i = 1 To 3000
        If Cells(i, 1) = "<td>子女姓名</td>" Then
            s = s + 1
            If s = 1 Then
               Rows("1:" & (i - 1)).Delete Shift:=xlUp
                Exit For
            End If
        End If
    Next

End Sub

Sub 确定位置2()
    Dim i, s
    For i = 1 To 3000
        If Cells(i, 1) = "<td>子女姓名</td>" Then
            s = s + 1
            If s = 2 Then
                Rows(i & ":600").Delete Shift:=xlUp
                Exit For
            End If
        End If
    Next
End Sub