J'ai regardé beaucoup d'autres articles sur ce problème similaire, mais ils n'ont pas résolu mon problème.Le code ne fonctionne pas lors de l'exécution mais le fait lors du débogage?
J'ai des données qui contiennent de mauvaises valeurs. J'ai utilisé le formatage conditionnel pour marquer ces valeurs en rouge. En raison de la taille des données, il n'est pas possible que mon script vérifie les formules/valeurs réelles, donc je vérifie la couleur affichée. Mon script est censé parcourir les colonnes, recherchant cette couleur, quand la couleur est trouvée, il copie la ligne dans une autre feuille (donc il peut être retourné avec un autre script plus tard) puis supprime la ligne d'origine et monte jusqu'à la ligne suivante . Par souci de taille et de vitesse, j'ai limité la zone de recherche à un point spécifique où je sais que les données sont mauvaises, donc marquées en rouge (ligne 337, colonne 22.)
Lorsque j'appelle la procédure en appuyant sur un bouton , il ne voit pas cette marque rouge. Quand je traverse le code, c'est le cas. J'ai réussi à épingler le problème sur la partie où je parcours les colonnes, mais je n'arrive pas à comprendre ce que je fais de mal.
Mon code:
Dim intSerialCount As Integer
intSerialCount = Sheet4.Range("I1").Value
Dim intBadDataSerialNumberStart As Integer
intBadDataSerialNumberStart = 3
Dim intBadDataSerialNumberCount As Integer
intBadDataSerialNumberCount = Sheet6.Cells(1, 2).Value
Dim intRowCnt As Integer
Dim intBeginRow As Integer
intBeginRow = intSerialCount + intBadDataSerialNumberStart - 1
Dim intEndRow As Integer
intEndRow = 333 'intBadDataSerialNumberStart
Dim intColCnt As Integer
Dim intBeginCol As Integer
intBeginCol = 21 '7
Dim intEndCol As Integer
intEndCol = 23 '37
Dim button As MSForms.CommandButton
Set button = Sheets("ANALYSIS TOOL").CommandButton2
Dim strNoMatch As String
strNoMatch = "Something went wrong!"
Dim strTitle As String
strTitle = "KPI Tool"
Dim strPW As String
strPW = "******"
'========================================================================================
Application.ScreenUpdating = False
Debug.Print "checking sourcedata"
If Sheet2.Range("A1").Value = "" Then
Debug.Print "trimming sourcedata"
Sheet2.Activate
Sheet2.Columns("C:C").Select
Selection.Replace What:=" ", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Sheet2.Range("A1").Value = 1
Else
Debug.Print "Sourcedata already trimmed"
End If
If Sheet4.Range("H1").Value = False Then
Debug.Print "BadData already removed? = FALSE"
'----------------------------------------------------------------------------------------
'Reorganise_TruckAnalysis
Sheet3.AutoFilter.Sort.SortFields.Clear
Sheet3.AutoFilter.ShowAllData
Sheet3.Range("A3").FormulaR1C1 = "=IF(DATA!RC[2]=0,NA(),DATA!RC[2])" '=IF(DATA!C3=0;NA();DATA!C3)
Sheet3.Activate
Sheet3.Range("A3").Select
Sheet3.Range("A3").AutoFill Destination:=Range("A3:A500")
Sheet3.Calculate
Debug.Print "Reorganised TruckAnalysis"
'Loop Rows:
Debug.Print "Start looping rows"
For intRowCnt = intBeginRow To intEndRow Step -1
Debug.Print "Checking row " & intRowCnt
If IsError(Sheet3.Cells(intRowCnt, 1)) Then
Debug.Print "IsError found"
'do nothing, go to next row
Else
'Loop Columns:
Debug.Print "Start looping columns"
For intColCnt = intBeginCol To intEndCol
Debug.Print "Checking column " & intColCnt
If Sheet3.Cells(intRowCnt, intColCnt).DisplayFormat.Interior.ColorIndex = 3 Then
Debug.Print "Red Mark found"
If Sheet2.Cells(intRowCnt, 3).Value = Sheet3.Cells(intRowCnt, 1).Value Then
Debug.Print "Data Matches"
Application.CutCopyMode = False
Sheet2.Cells(intRowCnt, 3).EntireRow.Copy
Debug.Print "copying bad data"
Sheet6.Cells(intBadDataSerialNumberStart + intBadDataSerialNumberCount, 1).PasteSpecial Paste:=xlPasteFormats
Sheet6.Cells(intBadDataSerialNumberStart + intBadDataSerialNumberCount, 1).PasteSpecial Paste:=xlPasteValues
Sheet2.Cells(intRowCnt, 3).EntireRow.Delete Shift:=xlUp
Debug.Print "removing bad data from source"
intBadDataSerialNumberCount = intBadDataSerialNumberCount + 1
Exit For
Else
Debug.Print "Data doesn't match"
MsgBox strNoMatch, _
vbOKOnly + vbInformation, strTitle
End If
End If
Debug.Print "No Red mark found"
Next intColCnt
Debug.Print "Restarting column count"
intColCnt = intBeginCol
End If
Debug.Print "Finished looping columns"
Next intRowCnt
Debug.Print "Finished looping rows"
'Reorganise_TruckAnalysis
Debug.Print "Reorganising TruckAnalysis"
Sheets("TRUCK ANALYSIS").Unprotect Password:=strPW
Sheet3.AutoFilter.ShowAllData
Sheet3.Range("A3").FormulaR1C1 = "=IF(DATA!RC[2]=0,NA(),DATA!RC[2])" '=IF(DATA!C3=0;NA();DATA!C3)
Sheet3.Activate
Sheet3.Range("A3").Select
Sheet3.Range("A3").AutoFill Destination:=Range("A3:A500")
Sheet3.Calculate
Sheet4.Range("H1").Value = True
button.Caption = "RETURN BAD DATA"
Else
Debug.Print "BadData already removed? = TRUE"
'SCRIPT FOR RETURNING BAD DATA
If intBadDataSerialNumberCount > 0 Then
Debug.Print "Secured Bad Data found"
intBeginRow = intBadDataSerialNumberStart
intEndRow = intBadDataSerialNumberStart + intBadDataSerialNumberCount
Debug.Print "Start looping rows"
For intRowCnt = intBeginRow To intEndRow
Debug.Print "checking row " & intRowCnt
Application.CutCopyMode = False
Sheet6.Cells(intRowCnt, 1).EntireRow.Copy
Sheet2.Cells(intSerialCount + intBadDataSerialNumberStart, 1).PasteSpecial Paste:=xlPasteValues
Sheet6.Cells(intRowCnt, 1).EntireRow.Clear
Next intRowCnt
End If
Sheets("ANALYSIS TOOL").Unprotect Password:=strPW
Sheet4.Range("H1").Value = False
button.Caption = "REMOVE BAD DATA"
'----------------------------------------------------------------------------------------
End If
Sheet4.Activate
End Sub
Debug.Print lors de l'exécution:
checking sourcedata
Sourcedata already trimmed
BadData already removed? = FALSE
Reorganised TruckAnalysis
Start looping rows
Checking row 337
Start looping columns
Checking column 21
No Red mark found
Checking column 22
No Red mark found
Checking column 23
No Red mark found
Restarting column count
Finished looping columns
Debug.Print lors du débogage:
checking sourcedata
Sourcedata already trimmed
BadData already removed? = FALSE
Reorganised TruckAnalysis
Start looping rows
Checking row 337
Start looping columns
Checking column 21
No Red mark found
Checking column 22
Red Mark found
Data Matches
copying bad data
removing bad data from source
Restarting column count
Finished looping columns