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

Question

我有些东西我认为可能相当简单。但是由于我对VBA的了解很少，我似乎无法使其工作。

这里就是我想要做的事：

Excel Sheet

我希望让他们适应了正确的列重新安排与字错误，失败或通过细胞。事实上，我解析的网页和数据的顺序发生了变化。如果我可以重新安排，这样一切都合适，那就完美了！

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

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

这是固定的我，因为我的数据是JSON，我只是用JSON解析转换器从https://codingislove.com/excel-json/ :)随时不过，如果你想达到什么我描述继续这个线程:)

Answer 2

看到它的另一种方法是，您要对每一行进行单独排序。 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 

附注中，"东西在你的数据是喧闹的，做一些预处理之初将其删除。一个陈述将做到：

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

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