Soru DEĞİŞTİRME

[hls06drm]

MERHABA;
AŞAĞIDAKİ ÖRNEK TABLODA YER ALAN MAYIS VE HAZİRAN AYLARINDAKİ İSİMLERİ SIRA NO DA YER ALAN İSİMLE TOPLU BİR ŞEKİLDE EN KOLAY NASIL DEĞİŞTİREBİLİRİM.

SIRA NO	MAYIS	HAZİRAN
1-AHMET	ELA	VELİ
2-MEHMET	AHMET	EMEL
3-VELİ	EMEL	ELA
4-EMEL	VELİ	MEHMET
5-ELA	MEHMET	AHMET

 

[Ali]

Insert-Module ile bir modüle ekle ve aşağıdaki kodlar çalıştırıp kontrol ediniz.

Sub IsimleriSirayaGoreDegistir()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim i As Long
    Dim sonSatir As Long
    
    ' Son satırı bul (SIRA NO sütununda veri olan son satır)
    sonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' 2. satırdan son satıra kadar döngü
    For i = 2 To sonSatir
        ' Mayıs ve Haziran sütunlarını SIRA NO sütunundaki isimle değiştir
        ws.Cells(i, 2).Value = ws.Cells(i, 1).Value ' Mayıs (B sütunu)
        ws.Cells(i, 3).Value = ws.Cells(i, 1).Value ' Haziran (C sütunu)
    Next i
End Sub

 

[hasankardas]

Ctrl+H işlemi işinizi görür..

 

[hls06drm]

Insert-Module ile bir modüle ekle ve aşağıdaki kodlar çalıştırıp kontrol ediniz.

Sub IsimleriSirayaGoreDegistir()
    Dim ws As Worksheet
    Set ws = ActiveSheet
   
    Dim i As Long
    Dim sonSatir As Long
   
    ' Son satırı bul (SIRA NO sütununda veri olan son satır)
    sonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
   
    ' 2. satırdan son satıra kadar döngü
    For i = 2 To sonSatir
        ' Mayıs ve Haziran sütunlarını SIRA NO sütunundaki isimle değiştir
        ws.Cells(i, 2).Value = ws.Cells(i, 1).Value ' Mayıs (B sütunu)
        ws.Cells(i, 3).Value = ws.Cells(i, 1).Value ' Haziran (C sütunu)
    Next i
End Sub

yardımlarınız için teşekkür ederim.........

 

[hls06drm]

Ctrl+H işlemi işinizi görür..

ilginiz için teşekkür ederim. Ctrl+H işleminde isimleri teker teker değiştirmek gerekiyor ben toplu bir şekilde değiştirmek istemiştim.

 

[hls06drm]

Insert-Module ile bir modüle ekle ve aşağıdaki kodlar çalıştırıp kontrol ediniz.

Sub IsimleriSirayaGoreDegistir()
    Dim ws As Worksheet
    Set ws = ActiveSheet
   
    Dim i As Long
    Dim sonSatir As Long
   
    ' Son satırı bul (SIRA NO sütununda veri olan son satır)
    sonSatir = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
   
    ' 2. satırdan son satıra kadar döngü
    For i = 2 To sonSatir
        ' Mayıs ve Haziran sütunlarını SIRA NO sütunundaki isimle değiştir
        ws.Cells(i, 2).Value = ws.Cells(i, 1).Value ' Mayıs (B sütunu)
        ws.Cells(i, 3).Value = ws.Cells(i, 1).Value ' Haziran (C sütunu)
    Next i
End Sub

kodlar çalıştı isimler değişti ama sıralaması yanlış oluyor.

 

[Muzaffer Ali]

Merhaba.
Alternatif

Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Sub Test()
    With Range("B2:C" & Cells(Rows.Count, "A").End(xlUp).Row)
        .Formula = "=A2"
        .Value = .Value
    End With
End Sub

 

[Korhan Ayhan]

Ben sorunuzu bu şekilde anladım...

Option Explicit

Sub Replace_Name()
    Dim Rng As Range
    
    On Error Resume Next
    
    For Each Rng In Range("B2:C" & Cells(Rows.Count, 1).End(3).Row)
        If Rng <> "" Then
            Rng = Evaluate("=IFERROR(INDEX(A:A,MATCH(""*-" & Rng & "*"",A:A,0)),"""")")
            If Err Then
                Rng = ""
                Err.Clear
            End If
        End If
    Next

    MsgBox "Verileriniz düzenlenmiştir."
End Sub

 

[hls06drm]

Ben sorunuzu bu şekilde anladım...

Option Explicit

Sub Replace_Name()
    Dim Rng As Range
   
    On Error Resume Next
   
    For Each Rng In Range("B2:C" & Cells(Rows.Count, 1).End(3).Row)
        If Rng <> "" Then
            Rng = Evaluate("=IFERROR(INDEX(A:A,MATCH(""*-" & Rng & "*"",A:A,0)),"""")")
            If Err Then
                Rng = ""
                Err.Clear
            End If
        End If
    Next

    MsgBox "Verileriniz düzenlenmiştir."
End Sub

kod çalıştı yardımlarınız için teşekkür ederim.........

 

[Necdet]

Alternatif olsun,
Korhan bey'in mantığı ile sadece vba kodları kullanılarak yapılmış hali:

Sub Duzelt()

Dim i   As Long
Dim c   As Range
Dim adr As String
Dim rng As Range

Application.ScreenUpdating = False

i = Cells(Rows.Count, "A").End(3).Row

For Each rng In Range("B2:C" & i)
    
    With Range("A:A")
        Set c = .Find(rng, LookIn:=xlValues)
        If Not c Is Nothing Then
            adr = c.Address
            Do
                rng = c
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> adr
        End If
    End With
    
Next rng
Application.ScreenUpdating = True

End Sub