Fonksiyon Ile Sayfalar Arasi Baglantili Verileri Siralama

Fonksiyon Ile Sayfalar Arasi Baglantili Verileri Siralama

Bir onceki konumuzda ayni konunun makrolu versiyonunu konu edinmis ve anlatmistim.. simdi ayni konunun fonksiyonlarla nasil cozulebilecegine dair cesitli fonksiyon cozumleri sunacagim..

Yine ornek dosyayi indirmenizi ve anlattiklarimi ordan takip etmenizi isteyecegim, ilk olarak D3`teki formulumuzle baslayalim..

=IF(A3<>””,IF(ISNUMBER(MATCH(A3,$A$2:A2,0)),””,=COUNTIF($D$2:$D6,”>”&0)+1),””)
=EĞER(A3<>””;EĞER(SAYIDIR(KAÇINCI(A3;$A$2:A2;0)),””,EĞERSAY($D$2:$D6,”>”&0)+1;””)

Bu formulu parca parca incelersek daha iyi anlasilabilir saniyorum;

ilk parcamiz;

IF(ISNUMBER(MATCH(A3,$A$2:A2,0)),””,COUNT..

MATCH fonksiyonunun sonucu daima sayidir buradaki ornegimizde A3 degerini $A$2:A2 araliginda arar ve bu formul asagi sekildikce bu aralik buyur.. Burada A3 degerimiz “Mustafa” ve bu aralikta yok.. Formulumuzde bunu istiyor zaten ISNUMBER fonksiyonunun sonucu hayir cikiyor ve IF fonksiyonunun TRUE bolumu olan “” bolumunu gecip COUNT.. diye baslayan tarafa gecmesini sagliyor..

Simdi Bu COUNTIF`le baslayan bolumu inceleyelim;

=COUNTIF($D$2:$D6,”>”&0)+1

Bu fonksiyonumuz ıse $D$2:$D6 aralıgındakı 0″dan buyuk olan sayıların kac tane oldugunu sayar ve 1 ekleyerek bu sayıları bırer kez arttırır.. bu formulumuz ayrica F1 satirindada kullanilmis..

formulumuzu parca parca anlattik, fakat kafanizda mantiginin olustugunu saniyorum.. Bu formulle sonucuna vararak listedeki 6 degisik ismi suzmemiz kolaylasicak..

Buradan sonrasini lutfen dosyadan inceleyiniz, anlayamadiginiz formuller olucaktir, yorumlarinizda bunlari sorarsaniz konuya daha sonrada devam ederim, suan bellirli bi yogunlugu asmam gerekiyor, afiyetle..

Fonksiyon Ile Sayfalar Arasi Baglantili Verileri Siralama

Hoşgeldiniz! Sizleri Tanıyalım…

Merhaba ben Muhammet Mustafa ASLAN; 2010’dan beri ExcelTR icin yazmaktayim, ExcelTR biraz data ambari biraz da bilgi paylasimi amacli kurulmus bir egitim sitesi. Bu anlamda site bireyleri ile dayanisma icerisinde yillardir emek harciyoruz, emegi gecen herkese bu basliktan da ayrica tesekkur etmek isterim.

Bu anlamda yabancilara pek sicak bakmiyoruz 🙂

Muhammet Mustafa ASLAN
CEO, Chief Excel Officer

Open dialog penceresi yardimi ile dosya adresi alma

Bazen dosya yolunu dialog penceresi yardimi ile vermek isteyebilirsiniz ve bunun icin cok kolay bir yontem var, bununla ilgili kod yapisini asagida gorebilrisiniz.

Sub Dosya_Yolu()

Dim Dizin As Variant

Dizin = Application.GetOpenFilename

MsgBox ("Dosya Yolu su sekildedir: " & Dizin)

End Sub

Excel Sayfasinin Varligini Kontrol Etme (Sheet Exist)

Calismanizdaki bir metin ile sayfanin varliginin kontrolunu yapmak isteyebilirsiniz, bunun icin ornek bir kod yapisi paylasiyoruz,

Private Function Sayfa_Varmi(Sayfa_Adi) As Boolean

On Error Resume Next

Sayfa_Varmi = (Sheets(Sayfa_Adi).Name <> "")

On Error GoTo 0

End Function


Sub Sayfa_Kontrolu()

Dim Kontrol As Boolean

Kontrol = Sayfa_Varmi("Sheet2")
MsgBox (Kontrol)

End Sub

VBA ile Dosya Acik mi Kontrolu

Istediginiz bir dosyanin adresini vererek dosyanin acik olup olmadigi kontrolunu yapabileceginiz bir kod paylasiyorum, kodumda herhangi bir dizin belirtmeyecegim yani bulundugumuz klasoru kontrol ediyor olacak.

“Hedef.xlsx” olarak belirttigimiz bolumu dosya dizinini girerekte istediginiz bir klasordeki istediginiz bir dosyanin acik mi oldugu kontrolunu yapabilirsiniz.

Private Function Dosya_Acikmi(mtn_Dosya_Adi) As Boolean
     
Dim w As Workbook
On Error Resume Next
Set w = Workbook(mtn_Dosya_Adi)
If Err Then Dosya_Acikmi = False Else Dosya_Acikmi = True
On Error GoTo 0

End Function

Sub Dosya_Acikmi_Kontrolu()

Kontrol_Sonucu = Dosya_Acikmi("Hedef.xlsx")
MsgBox (Kontrol_Sonucu)

End Sub

VBA ile filtre yaparak mukerrer olamayan degerleri gosterme

Istediginiz sutunda islem yaparken o sutunda bulunan degerleri birer kez yani mukerrer olmadan gosterebileceginiz bir kod ornegi paylasiyoruz.

Sub mukerrer_olmayan_degerler()

Dim mtn_adres As String
    
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address

Range(mtn_adres).AdvancedFilter Action:=xlFilterInPlace, Unique:=True

End Sub

VBA ile iki yada daha fazla alan filtreleme

Bulunulan alanda filtre uygulamasi yapabileceginiz ve filtrenizde iki yahut daha fazla kriter kullanabileceginiz iki ornek paylasiyoruz,

ilk ornegimiz filtre icin kullanabileceginiz 2 kriter secebilme olacak ama genel anlamda ikinci ornegimize dikkatinizi cekmek isterim;

Sub iki_Alan_Icin()
    
Dim mtn_adres As String
   
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address

ActiveSheet.Range(mtn_adres).AutoFilter Field:=2, Criteria1:="=Ankara", _
   Operator:=xlOr, Criteria2:="=Istanbul"
   
End Sub

Diger ornegimiz ise birden fazla filtre uygulayabileceginiz ve VBA’de genel olarak bir aralik vermek istediginizde gecerli olan array kullanimi uzerine olucak,

Sub Birden_Fazlasi_Icin()

Dim mtn_adres As String
   
Selection.AutoFilter

mtn_adres = ActiveCell.CurrentRegion.Address
ActiveSheet.Range(mtn_adres).AutoFilter Field:=2, Criteria1:=Array( _
        "Ankara", "Istanbul", "Bursa"), Operator:=xlFilterValues

End Sub

Outlook’a Task Acma – Guncelleme

Outlooktaki goruntusude yukaridaki sekilde olacaktir.

Asagida ekran goruntunu gordugunuz sekilde bir dosyadan outlook uzerinde task’lar acmaya ve guncellemeye yonelik bir calisma paylasiyorum.

Outlook_Task_Acma_Excel

Task Yaratma;

[kleo_tabs centered=””] [kleo_tab title=”Task Yaratma” active=0]

[kleo_colored_text color=”#F00056″]

Option Explicit

Sub Create_Task()
‘Microsoft Object Library x.x referansi tool menusunden acilmali..

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim olItemToChange As Outlook.TaskItem
Dim olNS As Object
Dim olItems As Object
Dim Table_Start, Table_Finish As Integer
Dim X As Long

Set olApp = New Outlook.Application

Application.ScreenUpdating = False
‘ActiveSheet.Unprotect

Table_Start = ActiveSheet.ListObjects(“Tasks”).Range.Row + 1
Table_Finish = Table_Start + ActiveSheet.ListObjects(“Tasks”).Range.Rows.Count – 2

For X = Table_Start To Table_Finish
Set olNS = olApp.GetNamespace(“MAPI”)
‘Set olTask = olNS.GetDefaultFolder(13).Items
‘Set olItemToChange = olItems.Find(“[Subject] = DDDD”)
On Error Resume Next
Set olItemToChange = Nothing
Set olItemToChange = olNS.GetItemFromID(Cells(X, ActiveSheet.Range(“Tasks[ID]”).Column).Value)
‘olTask .Find(“[EntryID] = ‘FFF'”) ‘& Cells(X, “N”).Value)
‘If Cells(X, “N”).Value = “” Then
If olItemToChange Is Nothing Then

Set olTask = olApp.CreateItem(3)
With olTask
.Subject = Cells(X, ActiveSheet.Range(“Tasks[Description]”).Column).Value
.Body = Cells(X, ActiveSheet.Range(“Tasks[Content]”).Column).Value
.StartDate = Cells(X, ActiveSheet.Range(“Tasks[Start Date]”).Column).Value
.DueDate = Cells(X, ActiveSheet.Range(“Tasks[Due Date]”).Column).Value
.Status = olTaskWaiting
.Importance = olImportanceHigh
.ReminderSet = True
.ReminderTime = Cells(X, ActiveSheet.Range(“Tasks[Reminder]”).Column).Value
.ReminderPlaySound = True
.Save
End With
Cells(X, ActiveSheet.Range(“Tasks[ID]”).Column).Value = olTask.EntryID
End If
Next

Set olTask = Nothing
Set olApp = Nothing

Application.ScreenUpdating = True

MsgBox “Tasks have been successfully created..”, vbInformation
‘ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

[/kleo_colored_text]

[/kleo_tab]

[kleo_tab title=”Task Guncelleme” active=1]

[kleo_colored_text color=”#44444″]

Dim bWeStartedOutlook As Boolean

Function Update_Task(strName As String, dteDate As Date) As Boolean
‘ – hatirlatma tarihi ve son tarih ayni ise, fonksiyon ikisinide yeniler..
‘ – Outlookun acilip kapanmasi ile islem gerceklesir..

‘ (VBA) ile Kullanma:
‘ Dim task_guncelle As Boolean
‘ task_guncelle = Update_Task(“Konu”, “01/10/2010”)
‘ (KTF) Kullanimi:
‘ =Update_Task(“Konu”, “01/10/2010”)
‘ yada
‘ =Update_Task(A1, B1)
‘ A1 Konu oldugunda, B1 tarih oldugunda..

Dim olApp As Object
Dim olNS As Object
Dim olItems As Object
Dim olItemToChange As Object

‘ Hatirlatma tarihi gecmis olamaz..
If dteDate < Now Then
Update_Task = False
GoTo ExitProc
End If

On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0

If Not olApp Is Nothing Then
Set olNS = olApp.GetNamespace(“MAPI”)
Set olItems = olNS.GetDefaultFolder(13).Items
Set olItemToChange = olItems.Find(“[Subject] = ” & strName)
‘Tum konularin ayni olmasini isterseniz: Set olItemToChange = olItems.Item(strName)

If olItemToChange Is Nothing Then
Update_Task = False
GoTo ExitProc
End If

With olItemToChange
‘ Hatirlatma tarihi ve son tarih ayni ise ikisinide degistir
‘ yoksa hatirlatma tarihini degistir
If .ReminderTime = .DueDate Then
.ReminderTime = dteDate
.DueDate = dteDate
Else
.ReminderTime = dteDate
End If
.Save
End With

Update_Task = True
GoTo ExitProc

Else
Update_Task = False
GoTo ExitProc
End If

ExitProc:
If bWeStartedOutlook Then
olApp.Quit
End If
Set olApp = Nothing
Set olNS = Nothing
End Function

Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, “Outlook.Application”)
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject(“Outlook.Application”)
bWeStartedOutlook = True
End If
On Error GoTo 0
End Function

[/kleo_colored_text]

[/kleo_tab] [/kleo_tabs][kleo_tabs centered=””]

Outlook’a Task Acma – Guncelleme