Questo browser non è più supportato.
Esegui l'aggiornamento a Microsoft Edge per sfruttare i vantaggi di funzionalità più recenti, aggiornamenti della sicurezza e supporto tecnico.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Buongiorno,
ho cercato nel forum un argomento che potesse aiutarmi ma sinceramente non sono riuscito a trovarlo.
In pratica in un foglio excel ho bisogno di confrontare due colonne e cioè A1 con D1, A2 con D2,....,An con Dn che devono essere uguali fra loro (A1=D1, A2=D2 ecc.,) se questo non accade e uno dei confronti non rispetta la condizione, ho bisogno di un msg che mi indichi la cella della colonna D che non rispetta il requisito di uguaglianza con la corrispondente cella nella colonna A.
Grazie per la collaborazione.
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.
Risposta accettata dall'autore della domanda
Ciao Antonio,
Grazie!
Prego!
Per chiudere questo thread, vorrei gentilmente chiederti di segnare le risposte risolutive come Risposta. In questo modo, tu aiuterai anche coloro che potrebbero cercare soluzioni ai problemi simili negli archivi della Community.
===
Regards,
Norman
Risposta accettata dall'autore della domanda
Con il vb? Ci sarebbero altri modi.
Comunque, questo codice confronta A1 con D1, ecc. del Foglio1 e ti avverte dove non c'è uguaglianza.
MsgBox cella per cella:
Public Sub m_1()
Dim sh As Worksheet
Dim lRiga As Long
Dim lng As Long
Set sh = ThisWorkbook.Worksheets("Foglio1")
With sh
lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
For lng = 1 To lRiga
If .Cells(lng, 1).Value <> .Cells(lng, 4).Value Then
MsgBox "Celle: A" & lng & " - D" & lng & " diverse"
End If
Next
End With
Set sh = Nothing
End Sub
Unico MsgBox finale:
Public Sub m_2()
Dim sh As Worksheet
Dim lRiga As Long
Dim lng As Long
Dim s As String
Set sh = ThisWorkbook.Worksheets("Foglio1")
With sh
lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
For lng = 1 To lRiga
If .Cells(lng, 1).Value <> .Cells(lng, 4).Value Then
s = s & "Celle: A" & lng & " - D" & lng & " diverse" & vbNewLine
End If
Next
End With
MsgBox s
Set sh = Nothing
End Sub
Grazie!
Grazie mille faccio una prova e ti riferisco.
Ciao Antonio,
In pratica in un foglio excel ho bisogno di confrontare due colonne e cioè A1 con D1, A2 con D2,....,An con Dn che devono essere uguali fra loro (A1=D1, A2=D2 ecc.,) se questo non accade e uno dei confronti non rispetta la condizione, ho bisogno di un msg che mi indichi la cella della colonna D che non rispetta il requisito di uguaglianza con la corrispondente cella nella colonna A.
Supponendo che una semplice formula non sia sufficiente, prova qualcosa del genere:
'=========>>
Option Explicit
'--------->>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range, Rng2 As Range, rCell As Range
Dim LRow As Long
Dim arr As Variant, arr2 As Variant
Dim arrOut() As Variant
Dim i As Long, j As Long, k As Long
Dim sMsg As String
Const sFoglio As String = "Foglio1" '<<=== Modifica
Const primaColonna As String = "A" '<<=== Modifica
Const secondaColonna As String = "D" '<<=== Modifica
Const primaRiga As Long = 2 '<<=== Modifica
Const sStr As String = _
"Le celle non uguale sono:"
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
With SH
LRow = LastRow(SH, .Columns(primaColonna))
Set Rng = .Range(primaColonna & primaRiga). _
Resize(LRow - primaRiga + 1)
Set Rng2 = .Range(secondaColonna & primaRiga). _
Resize(LRow - primaRiga + 1)
End With
arr = Rng.Value
arr2 = Rng2.Value
For i = 1 To UBound(arr)
If UCase(arr(i, 1)) <> UCase(arr2(i, 1)) Then
j = j + 1
ReDim Preserve arrOut(j)
arrOut(j) = Rng.Cells(i).Address(0, 0) _
& vbTab _
& Rng2.Cells(i).Address(0, 0)
End If
Next i
If CBool(j) Then
sMsg = sStr & Join(arrOut, vbNewLine)
Else
sMsg = "Tutte le celle confrontate sono uguale"
End If
Call MsgBox(Prompt:=sMsg, _
Buttons:=vbInformation, _
Title:="CONFRONTO")
End Sub
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range)
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
End Function
'<<=========
===
Regards,
Norman