venerdì 20 dicembre 2019

vba Cancella Righe Con Cella Vuota o Non Numerica


'
Option Explicit
'
' vba Cancella Righe Con Cella Vuota o Non Numerica
'
Sub CancellaRigheConCellaVuotaoNonNumerica()
On Error GoTo errore
Dim quanterighe, contarighe, foglio, contenuto, colonnainput
Set foglio = Sheets(ActiveSheet.Name)
'
quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row
colonnainput = InputBox("colonna da pulire", "scelta", "C")
'
contarighe = quanterighe
While contarighe > 2
      contenuto = Trim(foglio.Cells(contarighe, colonnainput).Value)
      If Len(contenuto) = 0 Then
         Rows(contarighe).Delete Shift:=xlUp
      Else
         If IsNumeric(contenuto) = False Then
            Rows(contarighe).Delete Shift:=xlUp
         End If
       End If
       contarighe = contarighe - 1
Wend
'
terminato:
GoTo esci
errore:
foglio.Cells(contarighe, colonnainput).Select
esci:
'
End Sub

giovedì 19 dicembre 2019

' vba Evidenzia Celle Per Contenuto


'
Option Explicit
'
' vba Evidenzia Celle Per Contenuto
'
Sub EvidenziaCellePerContenuto()
    Dim re, strPattern As String, r As Range
    Set re = CreateObject("VBScript.RegExp")
    strPattern = InputBox("cosa deve contenure la cella:", "scelta", "")
    With re
        .Pattern = strPattern
        .IgnoreCase = True
        .Global = True
        For Each r In ActiveSheet.UsedRange
            If .test(r.Value) Then r.Interior.ColorIndex = 3
        Next r
    End With
    Set re = Nothing
End Sub
'

mercoledì 18 dicembre 2019

vba - excel - cancella righe del foglio con il valore della cella corrente



'
Option Explicit
'
' vba - excel - cancella righe del foglio con il valore della cella corrente
'
Sub cancellarigheconvalorecorrente()
'
Dim colonnaattiva, corrente As String, quanterighe, contarighe
Dim valorecellaattiva As String, foglio
Set foglio = Sheets(ActiveSheet.Name)
colonnaattiva = ActiveCell.Column
valorecellaattiva = Trim(ActiveCell.Value) ' valore cella attiva
'
Application.Cursor = xlWait
Application.ScreenUpdating = False
'
quanterighe = Range(foglio.UsedRange.Cells(foglio.UsedRange.Rows.Count, 1).Address).Row
'
For contarighe = quanterighe To 1 Step -1                               ' conteggio righe usate
    corrente = Trim(foglio.Cells(contarighe, colonnaattiva).Value)
    If corrente = valorecellaattiva Then
       foglio.Rows(contarighe).Delete
    End If
Next contarighe
'
Application.ScreenUpdating = True
Application.Cursor = xlDefault
'
'
End Sub