Macro salta celle se

Question

Ciao a tutti. Rieccomi!

Problema. Ho questa macro che mi inverte i numeri. Se positivi li fa diventare negativi e viceversa.

     For Each c In Range("D1:D400")

     If c.Value > 0 Or c.Value < 0 Then

     c.Value = c.Value * -1

     End If

     Next

Il problema è che in questa colonna non ci sono solo numeri a volte ci sono celle vuote, a volte testo.

Come faccio a dirgli se incontra celle con dentro altri valori di ignorarle e passare alla riga seguente?

Help me!

Answer 1

Prova la macro così modificata (su una copia del file ovviamente! ;-) )

Public Sub m()

On Error GoTo RigaErrore

    Dim sPathNome As String

    Dim wkMe As Workbook

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim shMe As Worksheet

    Dim rng As Range

    Dim lRiga As Long

    '<--- nuove dichiarazioni --->

    Dim newlRiga As Long

    Dim c As Range

    sPathNome = Application.GetOpenFilename( _

        "Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *xlsx; *.xlsm", _

        , "Selezionare il file")

    Application.ScreenUpdating = False

    Set wkMe = ThisWorkbook

    Set shMe = wkMe.Worksheets("Foglio1")

    Set wk = Workbooks.Open(sPathNome)

    Set sh = wk.Worksheets("Foglio1")

    Set rng = sh.Range("A1").CurrentRegion

    rng.Copy

    With shMe

        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        .Range("A" & lRiga).PasteSpecial

        Application.CutCopyMode = False

        '<--- inizio nuove righe codice --->

        newlRiga = .Range("A" & .Rows.Count).End(xlUp).Row

        For Each c In .Range("U" & lRiga & ":U" & newlRiga)

          If IsNumeric(c) Then

            c.Value = -c.Value

          End If

        Next c

        '<--- fine nuove righe codice --->

    End With

        wk.Close

    Application.ScreenUpdating = True

RigaChiusura:

    Set wkMe = Nothing

    Set shMe = Nothing

    Set wk = Nothing

    Set sh = Nothing

    Set rng = Nothing

    Exit Sub

RigaErrore:

    If Err.Number <> 1004 Then

        MsgBox Err.Number & vbNewLine & Err.Description

    End If

    Resume RigaChiusura

End Sub

Answer 2

Non ne esco più a capo!

Vi spiego il mio problema che cercavo di risolvere con questa macro ma credo che non è adatta.

Ho questa macro che qualche giorno fa mi ha fatto Mauro Gamberini a cui ho modificato _click per farla partire con un pulsante

Public Sub m()

On Error GoTo RigaErrore

    Dim sPathNome As String

    Dim wkMe As Workbook

    Dim wk As Workbook

    Dim sh As Worksheet

    Dim shMe As Worksheet

    Dim rng As Range

    Dim lRiga As Long

    sPathNome = Application.GetOpenFilename( _

        "Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *xlsx; *.xlsm", _

        , "Selezionare il file")

    Application.ScreenUpdating = False

    Set wkMe = ThisWorkbook

    Set shMe = wkMe.Worksheets("Foglio1")

    Set wk = Workbooks.Open(sPathNome)

    Set sh = wk.Worksheets("Foglio1")

    Set rng = sh.Range("A1").CurrentRegion

    rng.Copy

    With shMe

        lRiga = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        .Range("A" & lRiga).PasteSpecial

        Application.CutCopyMode = False

    End With

        wk.Close

    Application.ScreenUpdating = True

RigaChiusura:

    Set wkMe = Nothing

    Set shMe = Nothing

    Set wk = Nothing

    Set sh = Nothing

    Set rng = Nothing

    Exit Sub

RigaErrore:

    If Err.Number <> 1004 Then

        MsgBox Err.Number & vbNewLine & Err.Description

    End If

    Resume RigaChiusura

End Sub

Nella colonna U ci sono i numeri a cui devo cambiare segno se positivi li devo portare negativi e viceversa. Le macro che mi avete fatto funzionano, solo che dato che questa macro la faccio partire più volte i numeri della colonna cambiano sempre segno ogni volte che ne aggiungo altri.

Io li vorrei far cambiare solo una volta, ovvero quando eseguo la macro che mi fa il copia incolla.

Questa macro copia i dati da una cartella di lavoro, li incolla in un altra cartella di lavoro e vorrei che alle righe nella colonna U cambiasse il segno ai numeri presenti.

In questa colonna sono tutti numeri tranne la prima riga che volendo potremmo eliminare o non copiare in quanto non mi serve.  Ha sempre la medesima intestazione.

Ci ho studiato da questa mattina ma mi rendo conto di essere ignorante!

Answer 3

Senza complicarla troppo, se deve essere valida per tutti i fogli:

Public Sub m()

    Dim c As Range

    On Error Resume Next

    For Each c In Range("D1:D400")

        If c.Value <> 0 Then

            c.Value = c.Value * -1

        End If

    Next

    Set c = nothing

End Sub

altrimenti modifica:

Range("D1:D400")

così:

Foglio1.Range("D1:D400")

sostituendo Foglio1 con il nome del tuo foglio.

Answer 4

Ciao OnyOneWay,

Problema. Ho questa macro che mi inverte i numeri. Se positivi li fa diventare negativi e viceversa.

     For Each c In Range("D1:D400")

     If c.Value > 0 Or c.Value < 0 Then

     c.Value = c.Value * -1

     End If

     Next

Il problema è che in questa colonna non ci sono solo numeri a volte ci sono celle vuote, a volte testo.

Come faccio a dirgli se incontra celle con dentro altri valori di ignorarle e passare alla riga seguente?

Help me!

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim CalcMode As Long

    Const sFoglio As String = "Foglio1"          '<<=== Modifica

    Const sIntervallo As String = "D1:D400"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets("Foglio1")

    Set Rng = SH.Range(sIntervallo)

    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    For Each rCell In Range("D1:D400").Cells

        With rCell

            If IsNumeric(.Value) And .Value <> 0 Then

                .Value = -.Value

            End If

        End With

    Next rCell

XIT:

        With Application

            .Calculation = CalcMode

            .ScreenUpdating = True

        End With

End Sub

'<<=========

===

Regards,

Norman