Need to replace all the cells with "0" values in an excel array with blank using VBA

I need to run a macro that replace all the cells in an array that contain "0" only as value with a blank
At the same time, cells that contains 0 and other text/numbers eg. "Test01" should not be considered and left as they are

this is the code i wrote but it is really slow on a 3k row sheet

Set sht = ActiveWorkbook.Sheets("Nuova Base Dati")
sht.Activate
Set rng = Range(Range("B2"), Range("E" & sht.UsedRange.Rows.count))
For Each cell In rng
If cell.Value = "0" Then cell.Value = ""
Next

Any suggestion to make it quicker?

>Solution :

Please, use the next code. It uses two arrays and should be fast enough for a large range, too:

Sub ReplaceZero()
  Dim shT As Worksheet, arrE, r As Long, c As Long, arrFin
  Set shT = ActiveWorkbook.Sheets("Nuova Base Dati")

 'place the range to be processed in an array (for faster iteration):
 arrE = shT.Range(shT.Range("B2"), shT.Range("E" & shT.UsedRange.Rows.count)).Value2
 ReDim arrFin(1 To UBound(arrE), 1 To UBound(arrE, 2)) 'set dimensions of the final array, keeping the processing result
 For r = 1 To UBound(arrE)         'iterate between the array rows
    For c = 1 To UBound(arrE, 2)  'iterate between the array columns
        If arrE(r, c) = 0 Then
            arrFin(r, c) = ""             'write a null string in case of zero
        Else
             arrFin(r, c) = arrE(r, c)  'keep the existing value, if not zero
        End If
    Next c
 Next r
 'Drop the processed array content, at once:
 shT.Range("B2").resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin
End Sub