(09/11/2020, 00:48)feraz yazdı: Sağol abey bu soruları sormak bu güne nasipmişRica ederim.
Iyi çalışmalar.
Private Sub CommandButton1_Click()
Dim dic As Object
Dim son As Long, i As Long, aranan, aranan2, aranan3
Dim say As Long, arr()
say = 1
With ThisWorkbook.Sheets("Sayfa1")
.Range("H2:K" & Rows.Count).ClearContents
son = .Range("A" & Rows.Count).End(3).Row
ReDim arr(1 To son, 1 To 4)
If son < 2 Then Exit Sub
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To son
aranan = .Cells(i, 1).Value
aranan2 = .Cells(i, 2).Value
aranan3 = .Cells(i, 4).Value
If .Cells(i, 3).Value = "AÇIK" Then
If Not dic.Exists(aranan & "||" & aranan2) Then
dic.Add aranan & "||" & aranan2, aranan3
arr(say, 1) = aranan
arr(say, 2) = aranan2
arr(say, 3) = aranan3
arr(say, 4) = Empty
say = say + 1
End If
End If
Next
'----------------------------------------------------------
Set dic = CreateObject("Scripting.Dictionary")
say = 1
For i = 2 To son
aranan = .Cells(i, 1).Value
aranan2 = .Cells(i, 2).Value
aranan3 = .Cells(i, 4).Value
If .Cells(i, 3).Value = "KAPALI" Then
If Not dic.Exists(aranan & "||" & aranan2) Then
dic.Add aranan & "||" & aranan2, aranan3
arr(say, 4) = aranan3
say = say + 1
End If
End If
Next
If dic.Count > 0 Then .Range("H2").Resize(dic.Count, 4).Value = arr
End With
MsgBox "Bitti"
Set dic = Nothing: Erase arr
aranan = Empty: aranan2 = Empty: aranan3 = Empty
End Sub
(09/11/2020, 12:50)berduş yazdı: Burada tarih alani sorunlu ama normal tarih olsaydi excelde de ,accessteki gruplama sorgulari gibi pivot yapilamaz mi?Sorguda heralde tarih ve zaman gibi algılar heralde bu dosyadada abey emin değilim.
Gruplama sorgularinda da en küçük, büyük gibi degerler seçilebiliyor.