AccessTr.neT

Sabitleme değiştirildi.
Bir koşul daha eklersem formülü eklerim buraya birde makrolu yaparsam onuda eklerim.

=DOLAYLI(ADRES(TOPLA.ÇARPIM(($B$3:$B$7=$E$16)*($C3:C7=F16)*(SATIR($C$3:$C$7)))+1;SÜTUN(C1)))

Neyse makrolu olan dosyayıda ekleyeyim.
Formüllü olan için denemek için
yazınca bile hata veriyor yani sorun değil denem yapmamdaki amaç MALZEME1,MALZEME 2 gibide koşula eklemekti.

Private Sub Worksheet_Change(ByVal Target As Range)



    Dim aranan1 As String, aranan2 As String

    Dim kacinci1 As Integer, kacinci2 As Integer

    Dim i As Integer

    Dim sonSutun As Integer

    Dim arr(), say As Integer

    Const satirNo As Byte = 17

    Const baslangicSutunNo As Byte = 6

    Const adres As String = "E16"

    Const adres2 As String = "F16"

    

    If Target.Address(0, 0) <> adres Then Exit Sub

        If Range(adres).Value = "" Then

            Range(Cells(satirNo, "F"), Cells(satirNo - 1, Columns.Count)).ClearContents

            Range(Cells(satirNo - 1, "F"), Cells(satirNo, Columns.Count)).Borders.LineStyle = xlNone

            Exit Sub

        End If



    sonSutun = Cells(15, Columns.Count).End(xlToLeft).Column

    If sonSutun < baslangicSutunNo Then Exit Sub

    For i = baslangicSutunNo To sonSutun

        aranan1 = Target.Offset(-1, i - (baslangicSutunNo - 1)).Value

        aranan2 = Target.Value

        On Error Resume Next

        kacinci1 = WorksheetFunction.Match(aranan1, Rows(3), 0)

        kacinci2 = WorksheetFunction.Match(aranan2, Columns(2), 0)

        If kacinci1 > 0 And kacinci2 > 0 Then

            say = say + 1

            ReDim Preserve arr(1 To 2, 1 To say)

            arr(1, say) = Cells(kacinci2, kacinci1).Value

            arr(2, say) = Cells(kacinci2 + 1, kacinci1).Value

        Else

            Cells(satirNo, i).Value = ""

        End If

        On Error GoTo 0

    Next

    If say > 0 Then

        Range(adres2).Resize(2, UBound(arr, 2)).Value = arr

        Range(adres2, Range(adres2).End(xlDown).End(xlToRight)).Borders.LineStyle = 1

    End If

    Erase arr

End Sub

Makroluda Malzeme1,2,3 gibi şartlarıda ekledim.

(24/12/2020, 09:40)feraz yazdı: [ -> ]Sabitleme değiştirildi.
Bir koşul daha eklersem formülü eklerim buraya birde makrolu yaparsam onuda eklerim.

=DOLAYLI(ADRES(TOPLA.ÇARPIM(($B$3:$B$7=$E$16)*($C3:C7=F16)*(SATIR($C$3:$C$7)))+1;SÜTUN(C1)))

Sn. feraz,

Programımı şekillendirmeye başlamıştım ki bu kodda yine hata alıyorum. Gönderdiğiniz şekilde kodu yazmaya çalıştım ama sanırım tam anlayamadım ki hata yapıyorum. Rica etsem müsait olduğunuzda bakabilir misiniz ?

excelden çok anlamam ama madem ki daha başındasınız bence Access ile yapmayı deneyin kanımca çok daha kolay olur.

(25/12/2020, 12:16)huzun_bulutu yazdı: [ -> ]

(24/12/2020, 09:40)feraz yazdı: [ -> ]Sabitleme değiştirildi.
Bir koşul daha eklersem formülü eklerim buraya birde makrolu yaparsam onuda eklerim.

=DOLAYLI(ADRES(TOPLA.ÇARPIM(($B$3:$B$7=$E$16)*($C3:C7=F16)*(SATIR($C$3:$C$7)))+1;SÜTUN(C1)))

Sn. feraz,

Programımı şekillendirmeye başlamıştım ki bu kodda yine hata alıyorum. Gönderdiğiniz şekilde kodu yazmaya çalıştım ama sanırım tam anlayamadım ki hata yapıyorum. Rica etsem müsait olduğunuzda bakabilir misiniz ?

Formül olayından fazla anlamıyorum heleki dizi formüllerindende nerdeyse hiç.
Kod ile yaptım ve gifte anlattım nasıl olduğunu.Gerekirse Buton eklenir onunlada veriler gelir.
Tam anlamadım aslında REÇETE MALİYET HESAPLAMA sayfasında sadece B11 veri değişincemi veriler gelecek zira buna göre ayarladım.
Dizi formülleriyle olsa bile dosya çok yavaş çalışabilir.