VBA EXCEL - Impostare come condizione il colore del testo presente in una cella + effettuare azione all'interno di altro file

Question

Ciao a tutti,

vorrei sapere come posso impostare come condizione il colore del testo all'interno di una cella. Più precisamente vorrei effettuare questa operazione. Ho due file: FILE A e FILE B. 

For ogni riga all'interno della colonna 2 nel FILE A

if colore del testo all'interno della cella(i,2) è rosso then

vai sul file B

For ogni riga della colonna 4  nel file B

if cella(j,2) è vuota then

colora il testo di rosso all'interno della cella(i,1) del FILE A

end if

Next

End If

Next

Answer 1

Ciao Markus,

Benvenuto alla Community!

vorrei sapere come posso impostare come condizione il colore del testo all'interno di una cella. Più precisamente vorrei effettuare questa operazione. Ho due file: FILE A e FILE B. 

For ogni riga all'interno della colonna 2 nel FILE A

if colore del testo all'interno della cella(i,2) è rosso then

vai sul file B

For ogni riga della colonna 4  nel file B

if cella(j,2) è vuota then

colora il testo di rosso all'interno della cella(i,1) del FILE A

end if

Next

End If

Next

In un modulo standard del primo file, prova qualcosa del genere:

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

Option Explicit

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

Public Sub Tester()

    Dim WB As Workbook, WB2 As Workbook

    Dim SH As Worksheet, SH2 As Worksheet

    Dim Rng As Range, Rng2 As Range, rCell As Range

    Dim LRow As Long

    Dim i As Long

    Const sSecondoFile As String = _

                                   "MarkusB20161224.xlsx"      '<<=== Modifica

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

    Const sSecondoFoglio As String = "Foglio2"          '<<=== Modifica

    Const sPrimaColonna As String = "B"                     '<<=== Modifica

    Const sSecondaColonna As String = "D"                '<<=== Modifica

    Const iColore As Long = vbRed                             '<<=== Modifica

    Set WB = ThisWorkbook

    Set WB2 = Workbooks(sSecondoFile)

    Set SH = WB.Sheets(sPrimoFoglio)

    Set SH2 = WB2.Sheets(sSecondoFoglio)

    With SH

        LRow = LastRow(SH, .Columns(sPrimaColonna))

        Set Rng = .Cells(1, sPrimaColonna).Resize(LRow)

    End With

    Set Rng2 = SH2.Columns(sSecondaColonna)

    For i = 1 To Rng.Cells.Count

        With Rng.Cells(i)

            If .Font.Color = iColore Then

                If Rng2.Cells(i) = vbNullString Then

                  .Offset(0, -1).Font.Color = iColore

                End If

            End If

        End With

    Next i

End Sub

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

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range, _

                 Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

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

Potresti scaricare il miei due file di prova zippati nel file Markus20161224.zip a:

https://www.dropbox.com/s/0t9n6ghrjp64gy5/Markus20161224.zip?dl=0

===

Regards,

Norman