DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
kodunu yapıştırıp aşağı doğru çekin. Talebiniz karşılanacaktır. Umarım doğru anlamışımdır=VLOOKUP(A:A;Sheet1!A2:B912;2;0)
Merhaba
Excele sonuc adinda bir sheet daha ekledim. Birkac satirda olmasini istedigim sekilde manuel guncelleme yaptim. Umarim faydali olmustur.
Düzeltme;
Önce sayfa1 deki rol kodu sayfa2 de bulunup c deki değeri , sayfa1 deki c ye yazılır.
Sonra sayfa1 deki onaycı kodu, sayfa2 de bulunup c deki değeri sayfa1 deki f ye yazılır. Bu kod birden fazla ise a,b,c, aşağı satır açıp kopyalanıp çoğaltırıp ve f ye yeni değerler yazılır.
Doğru mudur?
Sub ekle()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
sh1sonsatir = sh1.Cells(Rows.Count, "A").End(3).Row
sh2sonsatir = sh2.Cells(Rows.Count, "A").End(3).Row
For i1 = sh1sonsatir To 3 Step -1
sh1rol = sh1.Cells(i1, "A").Value
sh1onay = sh1.Cells(i1, "D").Value
sh1name = sh1.Cells(i1, "C").Value
If sh1name <> "" Then GoTo atla1
For i2 = 2 To sh2sonsatir
sh2rol = sh2.Cells(i2, "A").Value
sh2mission = sh2.Cells(i2, "C").Value
If sh1rol = sh2rol Then
sh1.Cells(i1, "C").Value = sh2mission
eskirol = 0
If sh1onay = 585 Then
a = a
End If
For i3 = 2 To sh2sonsatir
sh2rol = sh2.Cells(i3, "A").Value
'If sh2rol > sh1rol Then Exit For
sh2mission = sh2.Cells(i3, "C").Value
If sh1onay = sh2rol And eskirol <> sh2rol Then
sh1.Cells(i1, "F").Value = sh2mission
eskirol = sh2rol
ElseIf sh1onay = sh2rol And eskirol = sh2rol Then
Rows(i1 + 1 & ":" & i1 + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
sh1.Cells(i1 + 1, "A").Value = sh1.Cells(i1, "A").Value
sh1.Cells(i1 + 1, "B").Value = sh1.Cells(i1, "B").Value
sh1.Cells(i1 + 1, "C").Value = sh1.Cells(i1, "C").Value
sh1.Cells(i1 + 1, "D").Value = sh1.Cells(i1, "D").Value
sh1.Cells(i1 + 1, "E").Value = sh1.Cells(i1, "E").Value
sh1.Cells(i1 + 1, "F").Value = sh2mission
eskirol = sh2rol
End If
Next i3
'Exit For
End If
Next i2
atla1:
Next i1
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
..141 rol kodunda bulunan Piyasalar Müdür Yardımcısı görevi karşısına yine 141 rol kodunda yer alan bu rolde dahil 6 rolün sıralanması, aşağıda belirttim. 141 rol de 6 tane görev var ve her bir görevin karşısına 6 görev gelecek şekilde sıralanması gibi..ı
Next i3
'Exit For
End If
Sizin gösterdiğiniz şekilde tırnak var ama ? nasıl bir tırnak koymalıyım ? Exit For yeşil renkte
Next i3
'Exit For
End If