• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

=BİRLES!C98 başka sayfadaki veriyi çekmeye çalışıyorum fakat olmadı.

V

vedat1905

Katılım
9 Haziran 2021
Mesajlar
11
Excel Vers. ve Dili
Excel 2016 pro plus ve Türkçe
bir sayfadaki veriyi =BİRLES!C98 ile çekiyorum fakat ilgili sayfadaki liste makro ile sürekli değiştiği için bu yöntem işe yaramıyor. nasıl çözerim değerliforum kullanıcıları.
 
vedat1905' Alıntı:
bir sayfadaki veriyi =BİRLES!C98 ile çekiyorum fakat ilgili sayfadaki liste makro ile sürekli değiştiği için bu yöntem işe yaramıyor. nasıl çözerim değerliforum kullanıcıları.
Genişletmek için tıkla ...
yani siz bir kere veriyi çektiğiniz zaman makro ile BİRLES!C98 hücresindeki veri değişsse bile sizin formülü yazdığınız yerdeyi veri değişmesin önceki gibi kalsın istiyorsunuz. Bu formül ile olmaz diye biliyiroum. formülü yazdığınız hücre için de bir makro yazılabilir. tuşa basınca istediğiniz zaman çalışır. Siz basmadığınız sürece veri değimez. bu şekilde olabilir.
 
şöyle bir şey sorsam yardımcı olabilir misiniz? 100 kişilik liste var a1 b1 c1 şeklinde ad soyad numara tarzında bu listeyi d1 de 1-25 d2de 26-50 d3de 51- 100 arası sayılar var ana listeyi 3e bölecek böleceği sayısı d(1,2,3)den çekecek. niye böyle böleceği sayı aralık değişiyor bunu sağlayak makro yazılabilir mi?
 
listeleri önceden açılmış liste1 liste2 liste 3 sayfalar var bunlara atacak.
 
vedat1905' Alıntı:
şöyle bir şey sorsam yardımcı olabilir misiniz? 100 kişilik liste var a1 b1 c1 şeklinde ad soyad numara tarzında bu listeyi d1 de 1-25 d2de 26-50 d3de 51- 100 arası sayılar var ana listeyi 3e bölecek böleceği sayısı d(1,2,3)den çekecek. niye böyle böleceği sayı aralık değişiyor bunu sağlayak makro yazılabilir mi?
Genişletmek için tıkla ...
her türlü makro yazılabilir hocam. dosya paylaşırsanız üzerinde deneriz. Bölünen veriler nereye yazılacak yeni sayfalara mı
 
vedat1905' Alıntı:
şöyle bir şey sorsam yardımcı olabilir misiniz? 100 kişilik liste var a1 b1 c1 şeklinde ad soyad numara tarzında bu listeyi d1 de 1-25 d2de 26-50 d3de 51- 100 arası sayılar var ana listeyi 3e bölecek böleceği sayısı d(1,2,3)den çekecek. niye böyle böleceği sayı aralık değişiyor bunu sağlayak makro yazılabilir mi?
Genişletmek için tıkla ...
istediğiniz işlemi yapacak kod. excelinizde lliste1 liste2 liste 3 sayfarları yoksa onu da otomatik oluşturur.
Kod: 
Sub VerileriListelereAyir()

    Dim wsKaynak As Worksheet
    Dim wsListe1 As Worksheet
    Dim wsListe2 As Worksheet
    Dim wsListe3 As Worksheet
    Dim sonSatirKaynak As Long
    Dim i As Long
    Dim aralik1Alt As Long, aralik1Ust As Long
    Dim aralik2Alt As Long, aralik2Ust As Long
    Dim aralik3Alt As Long, aralik3Ust As Long
    Dim hedefSatir1 As Long, hedefSatir2 As Long, hedefSatir3 As Long
    Dim varMi As Boolean

    ' Kaynak çalışma sayfasını ayarla
    Set wsKaynak = ThisWorkbook.ActiveSheet

    ' Hedef aralıkları D sütunundan al
    aralik1 = Split(wsKaynak.Range("D1").Value, "-")
    aralik2 = Split(wsKaynak.Range("D2").Value, "-")
    aralik3 = Split(wsKaynak.Range("D3").Value, "-")

    aralik1Alt = Trim(aralik1(0))
    aralik1Ust = Trim(aralik1(1))
    aralik2Alt = Trim(aralik2(0))
    aralik2Ust = Trim(aralik2(1))
    aralik3Alt = Trim(aralik3(0))
    aralik3Ust = Trim(aralik3(1))

    ' Liste sayfalarını kontrol et ve gerekirse oluştur
    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste1" Then
            Set wsListe1 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe1 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe1.Name = "liste1"
    End If

    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste2" Then
            Set wsListe2 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe2.Name = "liste2"
    End If

    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste3" Then
            Set wsListe3 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe3 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe3.Name = "liste3"
    End If

    ' Liste sayfalarına başlıkları yaz
    wsListe1.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value
    wsListe2.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value
    wsListe3.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value

    ' Kaynak sayfadaki son dolu satırı bul
    sonSatirKaynak = wsKaynak.Cells(Rows.Count, "A").End(xlUp).Row

    ' Hedef sayfalardaki ilk boş satırı belirle
    hedefSatir1 = 2
    hedefSatir2 = 2
    hedefSatir3 = 2

    ' Kaynak sayfadaki verileri döngüyle kontrol et ve ilgili listelere yaz
    For i = 2 To sonSatirKaynak ' Başlık satırını atla
        Dim numara As Long
        On Error Resume Next ' C sütununda sayısal olmayan değer varsa hatayı yoksay
        numara = CLng(wsKaynak.Cells(i, "C").Value)
        On Error GoTo 0

        If numara >= aralik1Alt And numara <= aralik1Ust Then
            wsListe1.Cells(hedefSatir1, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir1 = hedefSatir1 + 1
        ElseIf numara >= aralik2Alt And numara <= aralik2Ust Then
            wsListe2.Cells(hedefSatir2, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir2 = hedefSatir2 + 1
        ElseIf numara >= aralik3Alt And numara <= aralik3Ust Then
            wsListe3.Cells(hedefSatir3, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir3 = hedefSatir3 + 1
        End If
    Next i

    MsgBox "Veriler listelere ayrılmıştır.", vbInformation

End Sub
 
volki_112' Alıntı:
istediğiniz işlemi yapacak kod. excelinizde lliste1 liste2 liste 3 sayfarları yoksa onu da otomatik oluşturur.
Kod: 
Sub VerileriListelereAyir()

    Dim wsKaynak As Worksheet
    Dim wsListe1 As Worksheet
    Dim wsListe2 As Worksheet
    Dim wsListe3 As Worksheet
    Dim sonSatirKaynak As Long
    Dim i As Long
    Dim aralik1Alt As Long, aralik1Ust As Long
    Dim aralik2Alt As Long, aralik2Ust As Long
    Dim aralik3Alt As Long, aralik3Ust As Long
    Dim hedefSatir1 As Long, hedefSatir2 As Long, hedefSatir3 As Long
    Dim varMi As Boolean

    ' Kaynak çalışma sayfasını ayarla
    Set wsKaynak = ThisWorkbook.ActiveSheet

    ' Hedef aralıkları D sütunundan al
    aralik1 = Split(wsKaynak.Range("D1").Value, "-")
    aralik2 = Split(wsKaynak.Range("D2").Value, "-")
    aralik3 = Split(wsKaynak.Range("D3").Value, "-")

    aralik1Alt = Trim(aralik1(0))
    aralik1Ust = Trim(aralik1(1))
    aralik2Alt = Trim(aralik2(0))
    aralik2Ust = Trim(aralik2(1))
    aralik3Alt = Trim(aralik3(0))
    aralik3Ust = Trim(aralik3(1))

    ' Liste sayfalarını kontrol et ve gerekirse oluştur
    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste1" Then
            Set wsListe1 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe1 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe1.Name = "liste1"
    End If

    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste2" Then
            Set wsListe2 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe2.Name = "liste2"
    End If

    varMi = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "liste3" Then
            Set wsListe3 = ws
            varMi = True
            Exit For
        End If
    Next ws
    If Not varMi Then
        Set wsListe3 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsListe3.Name = "liste3"
    End If

    ' Liste sayfalarına başlıkları yaz
    wsListe1.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value
    wsListe2.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value
    wsListe3.Cells(1, 1).Resize(1, 3).Value = wsKaynak.Cells(1, 1).Resize(1, 3).Value

    ' Kaynak sayfadaki son dolu satırı bul
    sonSatirKaynak = wsKaynak.Cells(Rows.Count, "A").End(xlUp).Row

    ' Hedef sayfalardaki ilk boş satırı belirle
    hedefSatir1 = 2
    hedefSatir2 = 2
    hedefSatir3 = 2

    ' Kaynak sayfadaki verileri döngüyle kontrol et ve ilgili listelere yaz
    For i = 2 To sonSatirKaynak ' Başlık satırını atla
        Dim numara As Long
        On Error Resume Next ' C sütununda sayısal olmayan değer varsa hatayı yoksay
        numara = CLng(wsKaynak.Cells(i, "C").Value)
        On Error GoTo 0

        If numara >= aralik1Alt And numara <= aralik1Ust Then
            wsListe1.Cells(hedefSatir1, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir1 = hedefSatir1 + 1
        ElseIf numara >= aralik2Alt And numara <= aralik2Ust Then
            wsListe2.Cells(hedefSatir2, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir2 = hedefSatir2 + 1
        ElseIf numara >= aralik3Alt And numara <= aralik3Ust Then
            wsListe3.Cells(hedefSatir3, 1).Resize(1, 3).Value = wsKaynak.Cells(i, 1).Resize(1, 3).Value
            hedefSatir3 = hedefSatir3 + 1
        End If
    Next i

    MsgBox "Veriler listelere ayrılmıştır.", vbInformation

End Sub
Genişletmek için tıkla ...
mükemmel teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst