Satırdan Veri Getirtmek

[ali28]

Merhaba

E satırında yan yana sayılar var

D satırında da aynı şekilde yan yana sayılar var

E satırında olup D satırında olmayan değerleri görmek istiyorum.

Teşekkürler

 

[quesh]

Ekteki dosyayı inceleyiniz lütfen.

 

[ali28]

Sayın quesh

Örneğiniz çok güzel

Sadece sütunlarda olmayan sayıları getirtmek için neler yapılabilir?
Bu şekilde hepsi geliyor
ve bu işi formül ile yapabilir miyiz?

Teşekkürler

 

[Korhan Ayhan]

Selamlar,

İstediğiniz formülle çözmek zor gibi görünüyor. İsterseniz aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub VARMI_YOKMU()
    Dim S1 As Worksheet, S2 As Worksheet, X1 As Long, X2 As Integer, X3 As Integer
    Dim Veri As String, Ayır As Variant, Satır As Integer, Uzunluk As Integer
    
    Application.ScreenUpdating = False
        
    Set S1 = Sheets("Sayfa1")
    Set S2 = Worksheets.Add
    
    S1.Range("F:F").ClearContents
    
    For X1 = 2 To S1.Range("D65536").End(3).Row
        Satır = 1
        Uzunluk = 0
        Veri = Replace(UCase(S1.Cells(X1, "D")), "X", "+")
        Veri = Replace(Veri, "-", "+")
        Veri = Replace(Veri, "/", "+")
        Ayır = Split(Veri, "+")
        
        For X2 = 0 To UBound(Ayır)
            Uzunluk = Uzunluk + Len(Ayır(X2))
            S2.Cells(Satır, 1) = Ayır(X2)
            S2.Cells(Satır, 2) = Mid(S1.Cells(X1, "D"), Uzunluk + Satır, 1)
            Satır = Satır + 1
        Next
    
        Veri = Replace(UCase(S1.Cells(X1, "E")), "X", "+")
        Veri = Replace(Veri, "-", "+")
        Veri = Replace(Veri, "/", "+")
        Ayır = Split(Veri, "+")
        Satır = 1
        Uzunluk = 0
        
        For X2 = 0 To UBound(Ayır)
            Uzunluk = Uzunluk + Len(Ayır(X2))
            S2.Cells(Satır, 3) = Ayır(X2)
            S2.Cells(Satır, 4) = Mid(S1.Cells(X1, "E"), Uzunluk + Satır, 1)
            Satır = Satır + 1
        Next
    
        For X3 = 1 To S2.Range("C65536").End(3).Row
            If WorksheetFunction.CountIf(S2.Range("A:A"), S2.Cells(X3, "C")) = 0 Then
                If S1.Cells(X1, "F") = "" Then
                    S1.Cells(X1, "F") = S2.Cells(X3, "C") & S2.Cells(X3, "D")
                Else
                    S1.Cells(X1, "F") = S1.Cells(X1, "F") & S2.Cells(X3, "C") & S2.Cells(X3, "D")
                End If
            End If
        Next
        
        If Right(UCase(S1.Cells(X1, "F")), 1) = "+" Or _
            Right(UCase(S1.Cells(X1, "F")), 1) = "X" Or _
            Right(UCase(S1.Cells(X1, "F")), 1) = "/" Or _
            Right(UCase(S1.Cells(X1, "F")), 1) = "-" Then
            S1.Cells(X1, "F") = Mid(S1.Cells(X1, "F"), 1, Len(S1.Cells(X1, "F")) - 1)
        End If
                
        S2.Range("A:D").Clear
    Next
 
    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub