Escriba Verificar usando VBA

He escrito un código que lee una spreadsheet que está llena de procedimientos que serán llevados a cabo por los trabajadores y los divide en "turnos" basados ​​en la duración de cada actividad para que la preparación de ciertos pasos se pueda hacer antes.

Estoy buscando algo de ayuda, ya que si alguien ingresa text que no es un número integer (una nota o algo) en la pestaña "duración" (que está almacenada como "X" en este código), la macro se detiene prematuramente.

Estaba pensando que podría usar una instrucción if para comprobar esto, tal vez la function "IsNumeric()" , pero no se ejecutaría y sabía que no lo estaba haciendo correctamente.

 Private Sub CommandButton1_Click() 'define variables Dim duration As Integer, n As Long, i As Integer, x As Integer, m As Long Dim toolRange As Range, partRange As Range, perRange As Range, workRange As Range, ppeRange As Range n = 3 'indicates row m = 3 'concatenation counter duration = 0 'duration counter x = 0 'duration placeholder For i = 1 To 100 'Assumed max 50 shifts (This can be changed or solved with more code, but should be set higher than pnetworkingicted # of shifts) duration = 0 'resets duration for next count While duration < Worksheets("Shifts").Cells(6, "K").Value 'shift length can be altenetworking x = Worksheets("SR060-SR070").Cells(n, "F").Value duration = duration + x 'adds duration until it is over 320 n = n + 1 Wend With Worksheets("SR060-SR070") Set toolRange = .Range(.Cells(m, "H"), .Cells(n, "H")) 'creates tool range End With With Worksheets("SR060-SR070") Set partRange = .Range(.Cells(m, "I"), .Cells(n, "I")) 'creates part range End With With Worksheets("SR060-SR070") Set perRange = .Range(.Cells(m, "E"), .Cells(n, "E")) 'creates per range End With With Worksheets("SR060-SR070") Set workRange = .Range(.Cells(m, "P"), .Cells(n, "P")) 'creates permit range End With With Worksheets("SR060-SR070") Set ppeRange = .Range(.Cells(m, "Q"), .Cells(n, "Q")) 'creates ppe range End With Worksheets("Shifts").Cells(i + 1, 1).Value = i 'creates shift Worksheets("Shifts").Cells(i + 1, 2).Value = Application.Max(perRange) 'creates max per Worksheets("Shifts").Cells(i + 1, 3).Value = duration 'creates duration 'Worksheets("Shifts").Cells(i + 1, 4).Value = ConcatenateAllCellValuesInRange(toolRange) 'inputs tools Worksheets("Shifts").Cells(i + 1, 4).Value = ConcatUniq(toolRange, " ") 'inputs tools 'Worksheets("Shifts").Cells(i + 1, 5).Value = ConcatenateAllCellValuesInRange(partRange) 'inputs parts Worksheets("Shifts").Cells(i + 1, 5).Value = ConcatUniq(partRange, " ") 'inputs parts 'Worksheets("Shifts").Cells(i + 1, 6).Value = ConcatenateAllCellValuesInRange(workRange) 'inputs permits Worksheets("Shifts").Cells(i + 1, 6).Value = ConcatUniq(workRange, " ") 'inputs permits 'Worksheets("Shifts").Cells(i + 1, 7).Value = ConcatenateAllCellValuesInRange(ppeRange) 'inputs ppe Worksheets("Shifts").Cells(i + 1, 7).Value = ConcatUniq(ppeRange, " ") 'inputs ppe m = n 'Allows it to segement down page Next i 'goes to next shift End Sub 'Concatenate function Function ConcatUniq(ByRef rng As Range, _ ByVal myJoin As String) As String Dim r As Range Static dic As Object If dic Is Nothing Then _ Set dic = CreateObject("Scripting.Dictionary") For Each r In rng dic(r.Value) = Empty Next ConcatUniq = Join$(dic.keys, myJoin) dic.RemoveAll End Function 

Puede usar la function Val para get la parte numérica de una cadena. Val también devolverá 0 si el valor no es numérico o cadena vacía. Puede combinar esto con IsNumeric en su condición While.

 Dim vVal As Variant Dim nVal As Long vVal = Worksheets("Shifts").Cells(6, "K").Value nVal = Val(vVal) While duration < nVal && IsNumeric(vVal) ... Wend 

Referencias

  • Función Val – VBA
  • Función IsNumeric – VBA