Soru Veri Çekme Hk.

murat_fidan · 14 Ekim 2023

Değerli arkadaşlar paylaşmış olduğum çalışmanın içindeki makro ile verileri çekiyorum. Ancak karşılaştığım bir sorun var. Dosyanın içinde açıklamasını yazdım. Yardımcı olurmusunuz. Dosyamın linki: https://s2.dosya.tc/server26/6v1azk/LISTE_CEKME.xlsm.html

Tevfik_Kursun · 14 Ekim 2023

Merhaba Arkadaşım,
Dosyanızdaki veriler umarım geçerli TC lerle oluşturulmuş veriler değildir. Öyle ise lütfen dosyanızı değiştirin.
Dosyanızda istediğiniz işlem için yapmanız gereken; BİRLEŞTİRME sayfanızda gerçek verileri kullanarak işlem yapın, sonrasında A sütunundaki verilerinizi şu andaki haliyle maskeleyin.
iyi çalışmalar

veyselemre · 14 Ekim 2023

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky
    Dim i As Integer

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(dizi(i, 2), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), dizi(i, 2))
    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

murat_fidan · 14 Ekim 2023

Tevfik_Kursun' Alıntı:
Merhaba Arkadaşım,
Dosyanızdaki veriler umarım geçerli TC lerle oluşturulmuş veriler değildir. Öyle ise lütfen dosyanızı değiştirin.
Dosyanızda istediğiniz işlem için yapmanız gereken; BİRLEŞTİRME sayfanızda gerçek verileri kullanarak işlem yapın, sonrasında A sütunundaki verilerinizi şu andaki haliyle maskeleyin.
iyi çalışmalar

veriler ve tcler gerçek dışıdır

murat_fidan · 14 Ekim 2023

veyselemre' Alıntı:

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky
    Dim i As Integer

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(dizi(i, 2), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), dizi(i, 2))
    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

Veysel bey cevap için teşekkürler ancak verileri eksik getirdi

veyselemre · 14 Ekim 2023

veyselemre · 14 Ekim 2023

Hatalı Veri

SERTAÇ BAŞAR

BETÜL KAYA TEKİN

AZİZ KOPUZ

Sertaç Başar ve Aziz Kopuz dan sonra birer boşluk karakteri var.

BE*** KA******** yerine

BE*** TE*** olması lazım verinin gelmesi için. Önceki örneklerde bu şekilde

murat_fidan · 14 Ekim 2023

veyselemre' Alıntı:
Hatalı Veri

SERTAÇ BAŞAR
BETÜL KAYA TEKİN
AZİZ KOPUZ

Sertaç Başar ve Aziz Kopuz dan sonra birer boşluk karakteri var.

BE*** KA******** yerine

BE*** TE*** olması lazım verinin gelmesi için. Önceki örneklerde bu şekilde

BE*** KA******** yerine

BE*** TE*** olması lazım verinin gelmesi için. Önceki örneklerde bu şekilde

Veysel hocam açıklama için çok teşekkürler bu liste bize sistem üzerinden geldiği için sanırsam bayan personellerde iki soy isim kullandığı zaman listede ilk soy isminin ilk iki harfi olacak şekilde listeleniyor. bay personellerde örneğin İSMAİL MUSTAFA ÖZDEMİR de İS ile ÖZ'ü baz alıyor. Sorun bayan personellerde hem kendi soy ismini hemde eşinin soy ismini kullananlarda sorun yaşıyoruz sanırım. Buna bir çözüm bulabilirmiyiz acaba

veyselemre · 14 Ekim 2023

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky
    Dim i As Integer

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(Trim(dizi(i, 2)), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        If UBound(bl) = 2 Then
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(1), 2)
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        End If

    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

murat_fidan · 14 Ekim 2023

veyselemre' Alıntı:

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky
    Dim i As Integer

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(Trim(dizi(i, 2)), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        If UBound(bl) = 2 Then
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(1), 2)
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        End If

    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

Teşekkürler veysel hocam emeğine sağlık istediğim gibi sonuç aldım

murat_fidan · 16 Ekim 2023

veyselemre' Alıntı:

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky
    Dim i As Integer

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(Trim(dizi(i, 2)), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        If UBound(bl) = 2 Then
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(1), 2)
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        End If

    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

40*******80

FA*** TÜ*** AK*** YI****

63*******52

AB******** GE***** YI****

	NA** YA* ÖZ ER***

Veysel hocam merhabalar. Yazmış olduğunuz makroya bu kriterleride bulacak şekilde revize edebilirmisiniz. Bu verilerin karşılığını çekemedim maalesef

veyselemre · 18 Ekim 2023

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky, b, bl, i, ii

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(Trim(dizi(i, 2)), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        If UBound(bl) > 1 Then
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(1), 2)
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2)
            For Each b In bl
                ky = ky & Left(b, 2)
            Next b
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        End If

    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            Else
                ky = Replace(WorksheetFunction.Trim(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", " ")), " ", "*") & "*"
                For ii = 1 To UBound(dizi)
                    If dizi(ii, 1) & dizi(ii, 2) Like ky Then
                        .Cells(i, 3).Value = dizi(ii, 1)
                        .Cells(i, 4).Value = dizi(ii, 2)
                        Exit For
                    End If
                Next ii
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

murat_fidan · 18 Ekim 2023

veyselemre' Alıntı:

Kod:

Sub getir()
    Dim dizi As Variant, dic As Object, ky, b, bl, i, ii

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("GENEL LİSTE")
        dizi = .Range("B2:C" & .Cells(Rows.Count, 2).End(3).Row).Value
    End With

    For i = 1 To UBound(dizi)
        bl = Split(Trim(dizi(i, 2)), " ")
        ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(UBound(bl)), 2)
        dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        If UBound(bl) > 1 Then
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2) & Left(bl(0), 2) & Left(bl(1), 2)
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
            ky = Left(dizi(i, 1), 2) & Right(dizi(i, 1), 2)
            For Each b In bl
                ky = ky & Left(b, 2)
            Next b
            dic(ky) = Array(dizi(i, 1), Trim(dizi(i, 2)))
        End If

    Next i

    With Sheets("BİRLEŞTİRME")
        For i = 2 To .Cells(Rows.Count, 1).End(3).Row
            ky = Replace(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", ""), " ", "")
            If dic.exists(ky) Then
                .Cells(i, 3).Resize(, 2).Value = dic(ky)
            Else
                ky = Replace(WorksheetFunction.Trim(Replace(.Cells(i, 1).Value & .Cells(i, 2).Value, "*", " ")), " ", "*") & "*"
                For ii = 1 To UBound(dizi)
                    If dizi(ii, 1) & dizi(ii, 2) Like ky Then
                        .Cells(i, 3).Value = dizi(ii, 1)
                        .Cells(i, 4).Value = dizi(ii, 2)
                        Exit For
                    End If
                Next ii
            End If
        Next i
    End With

    MsgBox "İŞLEM TAMAM"
End Sub

Teşekkürler veysel hocam emeğine sağlık

Soru Veri Çekme Hk.

murat_fidan

Tevfik_Kursun

veyselemre

Özel Üye

murat_fidan

murat_fidan

veyselemre

Özel Üye

veyselemre

Özel Üye

murat_fidan

veyselemre

Özel Üye

murat_fidan

murat_fidan

veyselemre

Özel Üye

murat_fidan