vba ile sabit satır ekleme yardım

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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?
 
Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
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
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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
 
Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
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

ustat olmuşta kırmızı renk kısmını anlamaıdm o kısımda sorun var
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Örneğin B18 hücresine Veri sayfasında olmayan bir kod yazarsanız B18 hücresi kırmızı olur. Sorun olan nedir?
 
Katılım
1 Ağustos 2006
Mesajlar
179
Altın Üyelik Bitiş Tarihi
22-08-2024
çö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
 
Üst