- Katılım
- 5 Kasım 2007
- Mesajlar
- 4,727
- Excel Vers. ve Dili
- 64 Bit TR - Microsoft Office 365 - Win11 Home
Merhaba,
Sayfa11 (HAFTALIK_YEMEK_LİSTESİ) ve burada Benzersiz_Listele kodu var,
Modül5'te ise ,
İsteğim ; Modül5'teki HAFTALIK_YEMEK_LİSTESİ_AL koduna ilave yaparak Sayfadaki Benzersiz_Listele'yi çağırmak,
Teşekkür ederim.
Sayfa11 (HAFTALIK_YEMEK_LİSTESİ) ve burada Benzersiz_Listele kodu var,
Kod:
Sub Benzersiz_Listele()
Application.ScreenUpdating = False
Set dict = CreateObject("Scripting.Dictionary")
'Range("K4:K" & [K4].End(xlDown).Row).ClearContents
Range("K4:K43").ClearContents
a = Range("D4:i43").Value
For Each b In a
If b <> "" Then
dict(b) = ""
End If
Next b
[K4].Resize(dict.Count, 1) = Application.Transpose(dict.keys)
Application.ScreenUpdating = True
End Sub
Modül5'te ise ,
Kod:
Sub HAFTALIK_YEMEK_LİSTESİ_AL()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("HAFTALIK_YEMEK_LİSTESİ").Range("d4:ı44").ClearContents
Set S1 = ThisWorkbook.Worksheets("ANALİZ")
Set S2 = ThisWorkbook.Worksheets("HAFTALIK_YEMEK_LİSTESİ")
For q = 4 To 10
For i = 4 To 43
For k = 2 To S1.Range("A65536").End(xlUp).Row
aranan = S2.Cells(2, q) & S2.Cells(3, q) & S2.Cells(i, 2)
If S1.Cells(k, "f") = aranan Then
S2.Cells(i, q) = S1.Cells(k, "d")
End If
Next k
Next i
Next q
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
İsteğim ; Modül5'teki HAFTALIK_YEMEK_LİSTESİ_AL koduna ilave yaparak Sayfadaki Benzersiz_Listele'yi çağırmak,
Teşekkür ederim.
