Question

我认为可以解决这个问题很简单。但是，由于我对VBA的了解很少，我似乎无法使其发挥作用。

以下是我要做的事情：

我想重新排列单词ERROR，FAILED或PASSED，以便它们适合正确的列。实际上，我正在解析网页并且数据的顺序发生了变化。如果我可以重新安排，以便它完全正确，那么这将是完美的！

这是我到目前为止的代码：

Sub FindandcutPASS()
Dim rngA As Range
Dim cell As Range

Set rngA = Sheets("Sheet1").Range("H2:H1000")

For Each cell In rngA
    If InStr(cell.Text, "ERROR") > 0 Then
        Sheets("Sheet1").Range("J13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "FAILED") > 0 Then
        Sheets("Sheet1").Range("I13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "PASSED") > 0 Then
        Sheets("Sheet1").Range("H13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    End If

Next cell

End Sub

Sub FindandcutFAIL()
    Set rngA = Sheets("Sheet1").Range("I2:I1000")
For Each cell In rngA
    If InStr(cell.Text, "ERROR") > 0 Then
        Sheets("Sheet1").Range("J13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "FAILED") > 0 Then
        Sheets("Sheet1").Range("I13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "PASSED") > 0 Then
        Sheets("Sheet1").Range("H13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    End If
Next cell

End Sub

Sub FindandcutERROR()
    Set rngA = Sheets("Sheet1").Range("J2:J1000")
For Each cell In rngA
    If InStr(cell.Text, "ERROR") > 0 Then
        Sheets("Sheet1").Range("J13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "FAILED") > 0 Then
        Sheets("Sheet1").Range("I13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    ElseIf InStr(cell.Text, "PASSED") > 0 Then
        Sheets("Sheet1").Range("H13").Select
        Selection.Value = cell.Value
        cell.ClearContents
    End If
Next cell

End Sub

PS：我的代码仅在我执行其中一部分时才有效：

Sub FindandcutPASS()
Dim rngA As Range
Dim cell As Range

Set rngA = Sheets("Sheet1").Range("H2:H1000")

For Each cell In rngA
    If InStr(cell.Text, "ERROR") > 0 Then
        Sheets("Sheet1").Range("J13").Select
        Selection.Value = cell.Value
        cell.ClearContents
End If

Next cell

End Sub

感谢您的帮助!!

Answer 1

另一种看待它的方法是，你要分别对每一行进行排序。 Pass, Fail, Error是一种自定义排序，但幸运的是，它与数据范围内的降序相符。试试这个简短的代码：

Sub sortAllRows()
    Dim r As Range
    For Each r In Sheets("Sheet1").Range("H2:J1000").Rows
        r.Sort r, xlDescending
    Next
End Sub

p.s。，数据中的"内容很嘈杂，请在开始时进行一些预处理以删除它们。单个陈述将会：

 Sheets("Sheet1").Range("H2:J1000").Replace Chr(34), vbNullString

p.s.2我意识到如果某些行不完整，某些值migth会被放错位置。但这应该让你开始。

Answer 2

这对我来说是固定的，因为我的数据是一个JSON，我只是使用来自https://codingislove.com/excel-json/的json转换器解析它:)尽管如此，如果你想实现我所描述的继续这个线程：）

将具有特定单词的单元格移动到特定单元格 - VBA EXCEL

2 个答案: