Sub ExcelDestek80()
''metehan8001 / Feyzullah / 29/07/2019
Dim v As Worksheet: Set v = Sheets("veriler")
Dim o As Worksheet: Set o = Worksheets("ortak_stoklar")
With Sheets("karşılaştırma")
.Range("A2:N" & .Range("a" & .Rows.Count).End(xlUp).Row + 1).Clear
veriler = v.Range("I2:N14" & v.Cells(Rows.Count, "I").End(xlUp).Row)
For a = 2 To v.Cells(Rows.Count, 1).End(xlUp).Row
.Cells(a, 1).Resize(1, 7) = Array(v.Cells(a, 1), v.Cells(a, 2), v.Cells(a, 3), v.Cells(a, 4), v.Cells(a, 5), v.Cells(a, 6), v.Cells(a, 7))
Set bul = o.Range("A:A").Find(v.Cells(a, 4))
If Not bul Is Nothing Then deger = o.Cells(bul.Row, 3)
For b = 1 To v.Cells(Rows.Count, "I").End(xlUp).Row - 1
If veriler(b, 3) = deger Then
.Cells(a, 9).Resize(1, 6) = Array(veriler(b, 1), veriler(b, 2), veriler(b, 3), veriler(b, 4), veriler(b, 5), veriler(b, 6))
veriler(b, 1) = Empty: veriler(b, 2) = Empty: veriler(b, 3) = Empty: veriler(b, 4) = Empty: veriler(b, 5) = Empty: veriler(b, 6) = Empty:
Exit For
End If
Next b
deger = Empty
If .Range("I" & a) = "" Then .Range("A" & a & ":G" & a).Font.Color = vbRed
If .Cells(a, 6) <> .Cells(a, 13) And .Cells(a, 6) <> "" And .Cells(a, 13) <> "" Then .Cells(a, 6).Interior.Color = vbRed: .Cells(a, 13).Interior.Color = vbRed
Next a
For b = 1 To v.Cells(Rows.Count, "I").End(xlUp).Row
If veriler(b, 3) <> "" Then
a = .Range("a" & .Rows.Count).End(xlUp).Row + 1
.Cells(a, 9).Resize(1, 6) = Array(veriler(b, 1), veriler(b, 2), veriler(b, 3), veriler(b, 4), veriler(b, 5), veriler(b, 6))
.Cells(a, 9).Resize(1, 6).Font.Color = vbRed
End If
Next
End With
MsgBox " İşlem Tamamlandı", vbInformation + vbMsgBoxRtlReading, "www.ExcelDepo.Com": veriler = Empty
End Sub