- Katılım
- 24 Temmuz 2019
- Mesajlar
- 484
- Excel Vers. ve Dili
- EXCEL 2010 TÜRKÇE
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Private Sub UserForm_Initialize()
Set dz = CreateObject("scripting.dictionary")
yol = ThisWorkbook.Path
dosya = "İZİN DİLEKÇESİ-2020-2021-FOTO.xlsm"
Application.ScreenUpdating = False
GetObject (yol & "\" & dosya)
Set s1 = Workbooks(dosya).Sheets("Liste")
Son = s1.Cells(Rows.Count, 4).End(3).Row
ss = s1.Cells(Rows.Count, 3).End(3).Row
a = s1.Range("B2:H35" & Son).Value
b = s1.Range("B2:H35" & ss).Value
For i = 1 To UBound(a)
dz(CStr(a(i, 3))) = Array(a(i, 4), a(i, 2), a(i, 5), a(i, 6), a(i, 7))
dz(CStr(b(i, 4))) = Array(b(i, 3), b(i, 2), b(i, 5), b(i, 6), a(i, 7))
Next i
Workbooks(dosya).Close
Application.ScreenUpdating = True
With UserForm1.ListBox1
.BackColor = vbBlue
.ColumnCount = 8
.ColumnWidths = "30;50;130;80;130;70;70;70"
ListBox1.ColumnHeads = True
.ForeColor = vbWhite
If Sheets("İZİN").Range("A2") = Empty Then
.RowSource = Empty
Else
.RowSource = "İZİN!A2:H" & [İZİN!A65536].End(3).Row
End If
End With
End Sub