- Katılım
- 26 Şubat 2014
- Mesajlar
- 106
- Excel Vers. ve Dili
- 2019
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Gruplandir()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set s1 = Sheets("DATAA") ' veri sayfası
Set s2 = Sheets("LİSTE") 'aktarılan sayfa
son1 = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
s2.Range("D2:D" & son2).ClearContents
ReDim ara1(son1): ReDim ara2(son1):
For j = 3 To son1
ara1(j) = WorksheetFunction.Trim(s1.Cells(j, "A")) & WorksheetFunction.Trim(s1.Cells(j, "B"))
ara2(j) = 1
Next j
For r = 3 To son1
If ara2(r) = 1 Then
For i = r - 1 To son2
bulunan1 = WorksheetFunction.Trim(s2.Cells(i, "A")) & WorksheetFunction.Trim(s2.Cells(i, "B"))
If bulunan1 = ara1(r) Then
s2.Cells(i, "d").Value = s1.Cells(r, "d").Value
ara2(i) = 0
Exit For
End If
Next i
End If
Next r
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation, " Sonuç Penceresi"
End Sub
=İNDİS(DATAA!$C$2:$C$65536;TOPLA.ÇARPIM((KAÇINCI(A2&"@"&B2;DATAA!$A$2:$A$65536&"@"&DATAA!$B$2:$B$65536;0))))
=İNDİS(DATAA!$D$2:$D$65536;TOPLA.ÇARPIM((KAÇINCI(A2&"@"&B2;DATAA!$A$2:$A$65536&"@"&DATAA!$B$2:$B$65536;0))))