Macro

[RyouMax]

http://s4.dosya.tc/server2/8zdz03/CALISMA__2_.rar.html

linkte belirttiğim macro çalışmaktadır ben istediğim sütunları da ekledim.benim bu taplodan istediğim C ve E sütunlarının yerlerinin değişmesi ve kişinin çalıstığı bölgedeki trafo kodlarının sehirler sütunundaki karşılığının sehirleri sütununa eklenmesidir.Tabiki kişilerin ıd leri ile uyumlu bir şekilde çekilmelidir
yardım edebilecek olan herkese şimdiden teşekkürler...

 

[Asri]

Aşağıdaki kodu deneyiniz.

http://s2.dosya.tc/server2/is66yk/trafo_calisma.zip.html

Dim kisite, kisitj As String

Sub menu()

    Call c_e_degistir
    Call sehirleri_ekle
    
End Sub

Function varmi(degere, degerj) As Boolean
   degere = degere & ","
   liste = Split(degere, ",")
   For i = LBound(liste) To UBound(liste) - 1
     If liste(i) = degerj Then
        varmi = True
        Exit Function
     End If
   Next i
   varmi = False
End Function

Sub sehirleri_ekle()
  Sheets("DENEME").Select
  sonsatire = Cells(Rows.Count, "E").End(3).Row
  sonsatirj = Cells(Rows.Count, "J").End(3).Row
  For j = 2 To sonsatirj
     kisitj = Cells(j, "J").Value
     Cells(j, "M").Value = ""
     For e = 2 To sonsatire
        kisite = Cells(e, "E").Value
        sehirc = Cells(e, "C").Value
        If varmi(kisite, kisitj) Then
           If Cells(j, "M").Value = "" Then
              Cells(j, "M").Value = sehirc
           Else
              Cells(j, "M").Value = Cells(j, "M").Value & "," & sehirc
           End If
        End If
  
     Next e
  Next j
  
End Sub

Sub c_e_degistir()
  Sheets("DENEME").Select
  If Cells(1, 3).Value = "Kısı_ID" And Cells(1, 5).Value = "Şehirler" Then
    Columns("E:E").Select
    Selection.Cut
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("D:D").Select
    Selection.Cut
    Columns("E:H").Select
    Range("H1").Activate
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Range("D5").Select
 End If
End Sub

 

[RyouMax]

Kodu denediğimde hiç bişey çalışmadı

 

[RyouMax]

Yapabilecek bir arkadaş varsa dosyayı yükleyebilr yada link paylaşabilirse çok büyük sevap işler

 

[Asri]

Kodu denediğimde hiç bişey çalışmadı

Gönderdiğiniz örnek ile uyguladığınız sayfa farklı olabilir.

Dosya ilk mesajımda eklendi.

 

[Ömer BARAN]

Merhabalar.

Sayın asri'nin gönderdiği dosya üzerinde,
istediğiniz sütun değişikliğine ilişkin değişikliği de sağlayarak hazırladığım dosya ekte.

Sanırım istediğiniz tam olarak bu.
Dosyaya buradan ulaşabilirsiniz.
(Belge yenilendi. 31.07.2016 19:15)
.

 

[RyouMax]

Merhabalar. Ömer beyin paylaştığı ekteki Şehirler sütununda; Mükerrir nesneler olmamalıdır.Tekrar eden nesneleri düzeltmem için yardım edebilecek birisi varmı acaba ?

 

[Ömer BARAN]

Önceki mesajımın ekindeki belgeyi yeniledim, tekrar indirerek deneyiniz.

 

[Ömer BARAN]

Önceki cevabımın ekindeki belge tekrar yenilendi tekrar indirerek kontrol ediniz.

 

[RyouMax]

Ömer Baran Bey'e teşekkürü borç bilirim.