將特定單詞移動到特定單元格 - 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被放錯位置。但是這應該讓你開始。