• DİKKAT

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

vba ile sabit satır ekleme yardım

Asıl konunuzla çok alakasız bir duruma gelmiş dosyanız. Bu dosya üzerinden çalışılacaksa, eski konunuzu ve makroyu unutarak, bu dosya üzerinde nasıl bir işlem yapmak istediğinizi belirtir misiniz?
 
tabi söyle anlatayım yusuf bey PROFORMA INV. sayfasında B17 den başlayın ürün kodlarını yazacam veri sayfasından A sutün da eşleşirse bilgileri PROFORMA INV. sayfasına getirecek be PROFORMA INV. bos satılar gizlenecek
 
Aşağıdaki makroyu deneyiniz. Makro B17:B116 hücrelerini ayrı ayrı kontrol edip veri sayfasındaki karşılıklarını getiriyor (karşılık getirme kısmına karışmadım, yani hangi hücre hangi hücreye gelecek kısmı sizin ayarladığınız gibi duruyor). Eğer veri sayfasında aranan kod yoksa o hücreyi kırmızı yapıyor. Boş satırları da gizliyor:

PHP: 
Sub fatura()
Set s1 = Sheets("PROFORMA INV.")
Set s2 = Sheets("veri")

son = s2.Cells(Rows.Count, "A").End(3).Row

s1.[C17:L116].ClearContents
s1.Rows("17:116").Hidden = False

son2 = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("B17:B116").Interior.Color = xlNone
For i = 17 To 116
    If s1.Cells(i, "B") <> "" Then
        If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(i, "B")) = 0 Then
            s1.Cells(i, "B").Interior.Color = vbRed
        Else
            sat = WorksheetFunction.Match(s1.Cells(i, "B"), s2.Range("A1:A" & son2), 0)
            s1.Cells(i, "C") = s2.Cells(sat, "L")
            s1.Cells(i, "D") = s2.Cells(sat, "I")
            s1.Cells(i, "E") = s2.Cells(sat, "AE")
            s1.Cells(i, "F") = s2.Cells(sat, "Q")
            s1.Cells(i, "G") = s2.Cells(sat, "R")
            
            s1.Cells(i, "H") = s2.Cells(sat, "X")
            s1.Cells(i, "I") = s2.Cells(sat, "Y")
            s1.Cells(i, "J") = s2.Cells(sat, "Z")
            s1.Cells(i, "K") = s2.Cells(sat, "AA")
            s1.Cells(i, "L") = s2.Cells(sat, "AD")
        End If
    Else
        s1.Rows(i).Hidden = True
    End If
Next

s1.Range("G117") = Application.WorksheetFunction.Sum(s1.Range("G17:G116"))
s1.Range("C117") = Application.WorksheetFunction.Sum(s1.Range("C17:C116"))
s1.Range("H117") = Application.WorksheetFunction.Sum(s1.Range("H17:H116"))
s1.Range("I117") = Application.WorksheetFunction.Sum(s1.Range("I17:I116"))
s1.Range("J117") = Application.WorksheetFunction.Sum(s1.Range("J17:J116"))
s1.Range("K117") = Application.WorksheetFunction.Sum(s1.Range("K17:K116"))
s1.Range("L117") = Application.WorksheetFunction.Sum(s1.Range("L17:L116"))

s1.Range("B11") = s2.Range("A2")
s1.Range("B13") = s2.Range("B2")
s1.Range("B14") = s2.Range("C2")
s1.Range("F118") = s2.Range("O2")
s1.Range("G118") = s2.Range("P2")
s1.Range("AW1") = s2.Range("T2")
s1.Range("G133") = s2.Range("T2")

kayit = 116
s1.Range("AV1") = kayit

Call Belirli_Bir_Alandaki_Resimleri_Sil
Call baglan
'Call duseyara

End Sub
 
YUSUF44' Alıntı:
Aşağıdaki makroyu deneyiniz. Makro B17:B116 hücrelerini ayrı ayrı kontrol edip veri sayfasındaki karşılıklarını getiriyor (karşılık getirme kısmına karışmadım, yani hangi hücre hangi hücreye gelecek kısmı sizin ayarladığınız gibi duruyor). Eğer veri sayfasında aranan kod yoksa o hücreyi kırmızı yapıyor. Boş satırları da gizliyor:

PHP: 
Sub fatura()
Set s1 = Sheets("PROFORMA INV.")
Set s2 = Sheets("veri")

son = s2.Cells(Rows.Count, "A").End(3).Row

s1.[C17:L116].ClearContents
s1.Rows("17:116").Hidden = False

son2 = s1.Cells(Rows.Count, "A").End(3).Row
s1.Range("B17:B116").Interior.Color = xlNone
For i = 17 To 116
    If s1.Cells(i, "B") <> "" Then
        If WorksheetFunction.CountIf(s2.Range("A1:A" & son2), s1.Cells(i, "B")) = 0 Then
            s1.Cells(i, "B").Interior.Color = vbRed
        Else
            sat = WorksheetFunction.Match(s1.Cells(i, "B"), s2.Range("A1:A" & son2), 0)
            s1.Cells(i, "C") = s2.Cells(sat, "L")
            s1.Cells(i, "D") = s2.Cells(sat, "I")
            s1.Cells(i, "E") = s2.Cells(sat, "AE")
            s1.Cells(i, "F") = s2.Cells(sat, "Q")
            s1.Cells(i, "G") = s2.Cells(sat, "R")
           
            s1.Cells(i, "H") = s2.Cells(sat, "X")
            s1.Cells(i, "I") = s2.Cells(sat, "Y")
            s1.Cells(i, "J") = s2.Cells(sat, "Z")
            s1.Cells(i, "K") = s2.Cells(sat, "AA")
            s1.Cells(i, "L") = s2.Cells(sat, "AD")
        End If
    Else
        s1.Rows(i).Hidden = True
    End If
Next

s1.Range("G117") = Application.WorksheetFunction.Sum(s1.Range("G17:G116"))
s1.Range("C117") = Application.WorksheetFunction.Sum(s1.Range("C17:C116"))
s1.Range("H117") = Application.WorksheetFunction.Sum(s1.Range("H17:H116"))
s1.Range("I117") = Application.WorksheetFunction.Sum(s1.Range("I17:I116"))
s1.Range("J117") = Application.WorksheetFunction.Sum(s1.Range("J17:J116"))
s1.Range("K117") = Application.WorksheetFunction.Sum(s1.Range("K17:K116"))
s1.Range("L117") = Application.WorksheetFunction.Sum(s1.Range("L17:L116"))

s1.Range("B11") = s2.Range("A2")
s1.Range("B13") = s2.Range("B2")
s1.Range("B14") = s2.Range("C2")
s1.Range("F118") = s2.Range("O2")
s1.Range("G118") = s2.Range("P2")
s1.Range("AW1") = s2.Range("T2")
s1.Range("G133") = s2.Range("T2")

kayit = 116
s1.Range("AV1") = kayit

Call Belirli_Bir_Alandaki_Resimleri_Sil
Call baglan
'Call duseyara

End Sub
Genişletmek için tıkla ...


ustat olmuşta kırmızı renk kısmını anlamaıdm o kısımda sorun var
 
Örneğin B18 hücresine Veri sayfasında olmayan bir kod yazarsanız B18 hücresi kırmızı olur. Sorun olan nedir?
 
çözdüm teşekkür ederim

For i = 17 To 116
If s1.Cells(i, "B") <> "" Then
If WorksheetFunction.CountIf(s2.Range("A1:A" & son), s1.Cells(i, "B")) = 0 Then
s1.Cells(i, "B").Interior.Color = vbRed
Else
sat = WorksheetFunction.Match(s1.Cells(i, "B"), s2.Range("A1:A" & son), 0)


son2 yazılmış veri sayfasması son alıyor veriyi çok teşekkür ederim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst