• DİKKAT

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

Soru Makro çalışmıyor

B

byrcinar

Katılım
4 Mart 2021
Mesajlar
55
Excel Vers. ve Dili
office prof plus 2021
merhaba
daha önce burdan bir abimiz bana catering için yemek sayılarını tutacağımız bir excel yapmıştı ama pc ye atılan format vs durumlarından makrolar çalışmamaya başladı yardımcı olurmusunuz size zahmet, lakin excel sayfasını nereye ekleyebiliriz burdan
 
Merhaba.
Dosya > Seçenekler > Güven Merkezi > Güven Merkezi Ayarları > Makro Ayarları bölümünden “Tüm makroları etkinleştir” seçeneğini işaretleyin.

Dosyayı kapatıp yeniden açın.
 
Dosya üzerine sağ tıkla özelikler engellemeyi kaldır kutucuğunu doldur ve tamam yap
 
burda hata görüyormusunuz?

Sub dataya_analiz()
Application.ScreenUpdating = False
On Error Resume Next
Dim SayfaAdi As String

Set s1 = ThisWorkbook.Worksheets("data")
s1.Range("b2:z65536").ClearContents
For i = 2 To s1.Range("A65536").End(xlUp).Row
If s1.Cells(i, 1) <> "" Then

Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
SayfaAdi = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
If SayfaVarMi(SayfaAdi) = False Then

For k = 4 To s2.Range("A65536").End(xlUp).Row
For z = 5 To 97 Step 3
If s2.Cells(2, z) <> "" Then
tarihh = s2.Cells(2, z)
If s2.Cells(k, z) + s2.Cells(k, z + 1) + s2.Cells(k, z + 2) >= 1 Then
sonSatir = s1.Range("b65536").End(xlUp).Row + 1
s1.Cells(sonSatir, "b") = tarihh
s1.Cells(sonSatir, "c") = s2.Cells(k, "a") 'firma
s1.Cells(sonSatir, "d") = s2.Cells(k, "b") 'şoför
s1.Cells(sonSatir, "e") = s2.Cells(k, "c") 'kahvaltı fiyatı
s1.Cells(sonSatir, "f") = s2.Cells(k, "d") 'yemek fiyatı

If s2.Cells(k, z) >= 1 Then s1.Cells(sonSatir, "g") = s2.Cells(k, z)
If s2.Cells(k, z + 1) >= 1 Then s1.Cells(sonSatir, "h") = s2.Cells(k, z + 1)
If s2.Cells(k, z + 2) >= 1 Then s1.Cells(sonSatir, "ı") = s2.Cells(k, z + 2)

s1.Cells(sonSatir, "j") = s1.Cells(i, 1) 'sayfa adı
s1.Cells(sonSatir, "k") = s1.Cells(i, 1) & s1.Cells(sonSatir, "c") 'sayfaadı ve firmaadı
kahtut = s1.Cells(sonSatir, "e") * s1.Cells(sonSatir, "g")
öğltut = s1.Cells(sonSatir, "f") * s1.Cells(sonSatir, "h")
akştut = s1.Cells(sonSatir, "f") * s1.Cells(sonSatir, "ı")

s1.Cells(sonSatir, "L") = kahtut + öğltut + akştut 'sabah öğle akşam tutarları

End If
End If
Next z
Next k
End If
End If
Next i

For i = 2 To s1.Range("c65536").End(xlUp).Row
If WorksheetFunction.CountIf(s1.Range("c2:c" & i), s1.Cells(i, "c")) = 1 Then
sonn = s1.Range("m65536").End(xlUp).Row + 1
s1.Cells(sonn, "m") = s1.Cells(i, "c")
End If
Next i

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Sub cari_günlük_getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("CARİ GÜNLÜK")
s2.Range("a4:g65536").ClearContents
s2.Range("a4:g65536").Borders.LineStyle = xlNone
s2.Range("a4:g65536").Font.Bold = False

For i = 2 To s1.Range("b65536").End(xlUp).Row
arailktar = s2.Cells(1, 1)
arasontar = s2.Cells(2, 1)
arafirma = s2.Cells(1, 2)

bulilktar = s1.Cells(i, "b")
bulsontar = s1.Cells(i, "b")
bulfirma = s1.Cells(i, "c")

If arailktar = "" Then arailktar = bulilktar
If arasontar = "" Then arasontar = bulsontar
If arafirma = "" Then arafirma = bulfirma


If bulilktar >= arailktar And bulilktar <= arasontar And bulfirma = arafirma Then
sonSatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonSatir, 1) = s1.Cells(i, "b")
s2.Cells(sonSatir, 2) = s1.Cells(i, "g")
s2.Cells(sonSatir, 3) = s1.Cells(i, "h")
s2.Cells(sonSatir, 4) = s1.Cells(i, "ı")

s2.Cells(sonSatir, 5) = s1.Cells(i, "e")
s2.Cells(sonSatir, 6) = s1.Cells(i, "f")

kahvaltıederi = s2.Cells(sonSatir, 2) * s2.Cells(sonSatir, 5)
öğleederi = s2.Cells(sonSatir, 3) * s2.Cells(sonSatir, 6)
akşamederi = s2.Cells(sonSatir, 4) * s2.Cells(sonSatir, 6)
s2.Cells(sonSatir, 7) = kahvaltıederi + öğleederi + akşamederi
s2.Range("a" & sonSatir & ":g" & sonSatir).Borders.LineStyle = xlContinuous

End If
Next i

sonSatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonSatir, 1) = "TOPLAM"
s2.Cells(sonSatir, 2) = WorksheetFunction.Sum(s2.Range("b4" & ":b" & sonSatir - 1))
s2.Cells(sonSatir, 3) = WorksheetFunction.Sum(s2.Range("c4" & ":c" & sonSatir - 1))
s2.Cells(sonSatir, 4) = WorksheetFunction.Sum(s2.Range("d4" & ":d" & sonSatir - 1))
s2.Cells(sonSatir, 5) = WorksheetFunction.Sum(s2.Range("e4" & ":e" & sonSatir - 1))
s2.Cells(sonSatir, 6) = WorksheetFunction.Sum(s2.Range("f4" & ":f" & sonSatir - 1))
s2.Cells(sonSatir, 7) = WorksheetFunction.Sum(s2.Range("g4" & ":g" & sonSatir - 1))
s2.Range("a" & sonSatir & ":g" & sonSatir).Borders.LineStyle = xlContinuous
s2.Range("a" & sonSatir & ":g" & sonSatir).Font.Bold = True

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Sub cari_bakiye_getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("data")
Set s2 = ThisWorkbook.Worksheets("CARİ BAKİYE")
s1.Range("k2:k65536").ClearContents

sonn = s1.Range("b65536").End(xlUp).Row
s2.Range("a4:g65536").ClearContents
s2.Range("a4:g65536").Borders.LineStyle = xlNone

For i = 2 To s1.Range("b65536").End(xlUp).Row

arailktar = s2.Cells(1, 1)
arasontar = s2.Cells(2, 1)

bulilktar = s1.Cells(i, "b")
bulsontar = s1.Cells(i, "b")

If arailktar = "" Then arailktar = bulilktar
If arasontar = "" Then arasontar = bulsontar

If bulilktar >= arailktar And bulilktar <= arasontar Then
s1.Cells(i, "k") = s1.Cells(i, "j") & s1.Cells(i, "c")
End If
Next i

For i = 2 To s1.Range("k65536").End(xlUp).Row
If s1.Cells(i, "k") <> "" And WorksheetFunction.CountIf(s1.Range("k2:k" & i), s1.Cells(i, "k")) = 1 Then
sonSatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonSatir, 1) = s1.Cells(i, "j")
s2.Cells(sonSatir, 2) = s1.Cells(i, "c")
s2.Cells(sonSatir, 3) = WorksheetFunction.SumIf(s1.Range("k2:k" & sonn), s1.Cells(i, "k"), s1.Range("g2:g" & sonn))
s2.Cells(sonSatir, 4) = WorksheetFunction.SumIf(s1.Range("k2:k" & sonn), s1.Cells(i, "k"), s1.Range("h2:h" & sonn))
s2.Cells(sonSatir, 5) = WorksheetFunction.SumIf(s1.Range("k2:k" & sonn), s1.Cells(i, "k"), s1.Range("ı2:ı" & sonn))
s2.Cells(sonSatir, 6) = WorksheetFunction.SumIf(s1.Range("k2:k" & sonn), s1.Cells(i, "k"), s1.Range("L2:L" & sonn))
If s2.Cells(sonSatir, 3) = 0 Then s2.Cells(sonSatir, 3) = ""
If s2.Cells(sonSatir, 4) = 0 Then s2.Cells(sonSatir, 4) = ""
If s2.Cells(sonSatir, 5) = 0 Then s2.Cells(sonSatir, 5) = ""
s2.Range("a" & sonSatir & ":f" & sonSatir).Borders.LineStyle = xlContinuous
End If
Next i


Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub
 
Makro çalışmıyor derken, hatalı çalıştığını mı kast ediyorsunuz.

Ben bu kodlara ilk bakışta gördüğüm hatalar
1-Değişkenler tanımlanmamış
2- Herhangi bir hata olduğunda "On Error Resume Next" satırı ile ileti gösterilmesini engellemiş oluyorsunuz. Dolayısı ile hata ayıklama imkanı olmuyor.

Sizin kodlar çalışmıyordan kast ettiğiniz şey nedir?
Eğer kodlar çalışıyor ve hatalı çalışıyorsa, dosyanzızı ekleyerek tam olarak hangi kısımların çalışmadığını belirtiniz.

Dosyanızı dosya.tc gibi bir harici sitede paylaşabilirsiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst