Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 04-11-2017, 20:51   #51
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,244
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Alıntı:
vuranoğlu tarafından gönderildi Mesajı Görüntüle
İyi akşamlar.
PLİNT
Desteğin için teşekkür ederim.

İşlem giriş ekranında veriler çift tıklama ile getirildiğinde kaydet butonuna tekrar basıldığında aynı veri tekrar kaydediliyor.
Merhaba
"Kayıt" butonuna aşağıdaki gibi ek yapın.
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub CommandButton5_Click()
Dim Sat, Son As Integer
x = Sheets("VERİ").Range("a65536").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("VERİ").Range("A2:A" & x), TextBox1.Text) > 0 Then _
MsgBox "AYNI KAYIT MEVCUT": Exit Sub

If TextBox3.Value <> "" Then
'...
'...diğer kodlar
'...
 

Bu mesaj en son " 04-11-2017 " tarihinde saat 21:03 itibariyle PLİNT tarafından düzenlenmiştir....
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 05-11-2017, 20:02   #52
vuranoğlu
Altın Üye
 
vuranoğlu kullanıcısının avatarı
 
Giriş: 18/04/2008
Şehir: eskişehir
Mesaj: 100
Excel Vers. ve Dili:
excel 2007 tr
Varsayılan

İyi akşamlar.
http://s5.dosya.tc/server5/xwfg9c/DENE_19.rar.html
http://s5.dosya.tc/server5/7cwha8/UYGULA.rar.html " DENE 19 VE MİZAN "

Rapor süzme işlemi yapılırken çalışmayan hesaplarda geliyor.Bunu engellemek için
değişiklik yaptım.Bu defada birden fazla işlem yapan hesaplarda geliyor.Mizan sayfası eklendi.Mizan sayfasında yapılan işlemler e topla ile getiriliyor.Ancak mizan sayfasından verileri getiremedim.
Mizan sayfasında sonucu "0" olan satırları kaldırıyorum .Mizan içindeki listboxda değişiklik gözükmüyor.gecikmeli mi veriyi almak gerekecek?
s5.dosya.tc adresten dosya indiriken virus tarayıcısı izin vermiyor.Sizde de aynı mı?

Bu mesaj en son " 05-11-2017 " tarihinde saat 20:08 itibariyle vuranoğlu tarafından düzenlenmiştir....
vuranoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 07-11-2017, 00:43   #53
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,244
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Ek dosyayı inceleyin
Eklediğiniz "mizan" formundaki buton "mizan" sayfasını temizleyip "MİZAN.xlsm" dosyasından
verileri önce sayfaya sonra sıfırdan büyük değerli olanları listeye alacak ancak verileri çift tıklama ile textboxlara; silmek veya değişmek için alıyorsanız kodlara ek yapmak gerekir
"rapor" formu kod sayfasındaki tüm makrolarda değişiklik var.
https://drive.google.com/open?id=1mI...LVfTJDIriIDgmq
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-11-2017, 23:04   #54
vuranoğlu
Altın Üye
 
vuranoğlu kullanıcısının avatarı
 
Giriş: 18/04/2008
Şehir: eskişehir
Mesaj: 100
Excel Vers. ve Dili:
excel 2007 tr
Varsayılan

İyi geceler.


Private Sub CommandButton1_Click()
Set s1 = Sheets("MİZAN")
s1.Activate
s1.Range("A2:E" & Rows.Count).ClearContents
Set c = CreateObject("scripting.filesystemobject")
If c.FileExists(ThisWorkbook.Path & "\MİZAN.xlsm") = False Then
MsgBox "MİZAN.xlsm Dosyası bulunamadı" & vbCrLf & "Verilerin alınacağı MİZAN.xlsm dosyası bu dosyanın yanında olmalı"
Exit Sub
End If
Set con = CreateObject("Adodb.Connection")
Set dt = CreateObject("adodb.recordset")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.Path & "\MİZAN.xlsm" & ";Extended Properties = ""Excel 12.0 Macro;HDR=no"";"
sut = "Select [F1],[F2],[F3],[F4],[F6] From [RAPOR$A2:F65000]"
dt.Open sut, con, 1, 1

s1.Range("A2").CopyFromRecordset dt
dt.Close
Set dt = Nothing
Set con = Nothing
ListBox1.RowSource = ""
ListBox1.Clear
n = 0
rw = s1.Cells(Rows.Count, "A").End(3).Row
With ListBox1
For a = 1 To rw
If s1.Cells(a, "E") <> "" And s1.Cells(a, "E") > 0 Then
.AddItem s1.Cells(a, 1)
For t = 1 To 7
.list(n, t) = s1.Cells(a, t + 1).Text
If t > 2 And IsNumeric(.list(n, t)) = True Then .list(n, t) = Format(.list(n, t), "#,##0.00")
Next
n = n + 1
End If
Next
End With
End Sub



Private Sub Label1_Click()

End Sub

Private Sub ListBox1_Click()
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
TextBox1 = ListBox1.Column(0, i)
TextBox2 = ListBox1.Column(1, i)
TextBox3 = ListBox1.Column(5, i)
TextBox4 = ListBox1.Column(4, i)
TextBox5 = ListBox1.Column(6, i)
TextBox6 = ListBox1.Column(7, i)
'TextBox3 = ListBox1.Column(2, i)
'TextBox2 = ListBox1.Column(1, i)
'TextBox3 = ListBox1.Column(2, i)


End If
Next i
sat = ListBox1.ListIndex + 2
Range("A" & sat & ":E" & sat).Interior.ColorIndex = 5

End Sub



Private Sub UserForm_Activate()
'DEĞERİ SIFIR OLAN SATIRI SİL
Application.ScreenUpdating = False
Dim Rng As Range
Dim c As Range
Set Rng = Range("f2:f500")


hnd = FindWindow(vbNullString, Me.Caption)
SetTimer hnd, 0, 1000, AddressOf Timer
Label1 = Format(Time, "hh:mm:ss ")
Label13 = Format(Date, "dd.mm.yyyy")

MİZAN_Initialize

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
KillTimer hnd, 0
End Sub
Private Sub MİZAN_Initialize()
Me.Top = Application.Top
Me.Left = Application.Left
Me.Height = Application.Height
Me.Width = Application.Width
With MİZAN.ListBox1
.BackColor = vbWhite
.ColumnCount = 9
.ColumnWidths = "130;129;0;0;80;80;88;88;70"
.ForeColor = vbBlack
If Sheets("MİZAN").Range("a2") = Empty Then
.RowSource = Empty
Else
.RowSource = "MİZAN!a1:H" & [MİZAN!a65536].End(3).Row
End If
End With
End Sub

yukarıdaki kodlarla mizan sayfasındaki veriler ilk geldiğinde farklı aktarma yapınca (sütunlar)farklı geliyor.
Sütunlar
vuranoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-11-2017, 23:49   #55
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,244
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
Yani; listeye sıfır değerli olanlarda gelecek ise
https://drive.google.com/open?id=1GM...dN7BeOpWb8YNig

Ayrıca timer sonlandırma kodlarını
(Sanırım formu her zaman "X" düğmesinden kapatmayacaksınız; )
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
başlığı altında değilde; aşağıdaki gibi kullanalım

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub UserForm_Terminate()
KillTimer hnd, 0
End Sub
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-11-2017, 22:37   #56
vuranoğlu
Altın Üye
 
vuranoğlu kullanıcısının avatarı
 
Giriş: 18/04/2008
Şehir: eskişehir
Mesaj: 100
Excel Vers. ve Dili:
excel 2007 tr
Varsayılan

İyi akşamlar.

Son çalışmanız da değişik bir fikir verdi ama anlatmak istediğim;

Listbox a gelen ilk verileri sütun başlıklarına göre getiremiyorum.
Mizan değerleri karşılaştırıldığında değerler sütun başlıkların altına oturuyor.
Yapmak istediğim buydu. Anlatamadım sanıyorum .
İlginize teşekkürler.
http://s5.dosya.tc/server5/kni0c0/Desktop.rar.html
Listbox gelen verilerde mizan fazla sütun değerleri listbox dışındad kalıyor.
Eklenmiş Resimler
Dosya Türü: jpg mizan 1.JPG (110.5 KB, 3 Görüntülenme)
Dosya Türü: jpg mizan 2.JPG (105.1 KB, 2 Görüntülenme)
Eklenmiş Dosyalar
Dosya Türü: rar Desktop.rar (1.63 MB, 3 Görüntülenme)

Bu mesaj en son " 09-11-2017 " tarihinde saat 22:44 itibariyle vuranoğlu tarafından düzenlenmiştir....
vuranoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-11-2017, 22:55   #57
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,244
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Merhaba
"Listbox1/properties/TextAlign=3" yani gelen sayıların görünümü için sağa dayalı
"Listview" de sütunlar ayrı ayrı sağa sola ayarlanabiliyor ama "Listbox" da olmuyor.
Onun içinde son dosyada "Listbox" sütun sayısı 9 a çıkarmıştım (tabi son sütun boş)
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub MİZAN_Initialize()
With MİZAN.ListBox1
.BackColor = vbWhite
.ColumnCount = 9
.ColumnWidths = "100;100;0;0;60;60;60;60;10"
'...
'...
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-11-2017, 23:19   #58
vuranoğlu
Altın Üye
 
vuranoğlu kullanıcısının avatarı
 
Giriş: 18/04/2008
Şehir: eskişehir
Mesaj: 100
Excel Vers. ve Dili:
excel 2007 tr
Varsayılan

Mizan sayfasına alınan değerleri e topla ile yaptırdım ama satır artıkça sorun olacağa benziyor.mizan karşılatırma da formülle yapıldı .Makro ile yapabilir miyiz?

Bu mesaj en son " 09-11-2017 " tarihinde saat 23:40 itibariyle vuranoğlu tarafından düzenlenmiştir....
vuranoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 09-11-2017, 23:24   #59
vuranoğlu
Altın Üye
 
vuranoğlu kullanıcısının avatarı
 
Giriş: 18/04/2008
Şehir: eskişehir
Mesaj: 100
Excel Vers. ve Dili:
excel 2007 tr
Varsayılan

Mizan sayfasına alınan değerleri e topla ile yaptırdım ama satır artıkça sorun olacağa benziyor.Aynı zamanda da değerlerin fazla veya eksikliği de formülle yapıldı. Makro ile yapabilirmiyiz?
vuranoğlu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-11-2017, 00:03   #60
PLİNT
 
Giriş: 31/12/2014
Şehir: Gürün
Mesaj: 1,244
Excel Vers. ve Dili:
Excel 2010
Varsayılan

Alıntı:
vuranoğlu tarafından gönderildi Mesajı Görüntüle
Mizan sayfasına alınan değerleri e topla ile yaptırdım ama satır artıkça sorun olacağa benziyor.Aynı zamanda da değerlerin fazla veya eksikliği de formülle yapıldı. Makro ile yapabilirmiyiz?
En son eklediğimiz dosya "MİZAN" userformu; verileri getiren buton kodlarına (aşağıdaki kodların son bölümündeki mavi satırları) ekleyip/değiştirip deneyin
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Private Sub CommandButton1_Click()
Set s1 = Sheets("MİZAN") 'son eklenen kodlarıda ilgilendirir
s1.Activate
s1.Range("A2:E" & Rows.Count).ClearContents
   s1.Columns("E:H").NumberFormat = "#,##0.00"
Set c = CreateObject("scripting.filesystemobject")
If c.FileExists(ThisWorkbook.Path & "\MİZAN.xlsm") = False Then
MsgBox "MİZAN.xlsm Dosyası bulunamadı" & vbCrLf & "Verilerin alınacağı MİZAN.xlsm dosyası bu dosyanın yanında olmalı"
Exit Sub
End If
Set con = CreateObject("Adodb.Connection")
Set dt = CreateObject("adodb.recordset")
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.Path & "\MİZAN.xlsm" & ";Extended Properties = ""Excel 12.0 Macro;HDR=no"";"
   sut = "Select [F1],[F2],[F3],[F4],[F6] From [RAPOR$A2:F65000]"
dt.Open sut, con, 1, 1

s1.Range("A2").CopyFromRecordset dt
dt.Close
Set dt = Nothing
Set con = Nothing
ListBox1.RowSource = "MİZAN!a1:I" & [MİZAN!a65536].End(3).Row

'ListBox1.RowSource = ""
'ListBox1.Clear
'n = 0
'rw = s1.Cells(Rows.Count, "A").End(3).Row
'With ListBox1
'For a = 1 To rw
'If s1.Cells(a, "E") <> "" And s1.Cells(a, "E") > 0 Then
'.AddItem s1.Cells(a, 1)
'For t = 1 To 7
'.list(n, t) = s1.Cells(a, t + 1).Text
'Next
'n = n + 1
'End If
'Next
'End With
Application.Calculation = xlCalculationManual
On Error Resume Next
Set s2 = Sheets("VERİ")
v = s2.Cells(Rows.Count, "A").End(3).Row
With Sheets("MİZAN")
For p = 2 To .Cells(Rows.Count, "B").End(3).Row
.Cells(p, "F") = WorksheetFunction.SumIf(s2.Range("H2:H" & v), .Cells(p, "B").Value, s2.Range("O2:O" & v))
If CDbl(.Cells(p, "E")) - CDbl(.Cells(p, "F")) < 0 Then
.Cells(p, "G") = 0
.Cells(p, "H") = CDbl(.Cells(p, "F")) - CDbl(.Cells(p, "E"))
Else
.Cells(p, "G") = CDbl(.Cells(p, "E")) - CDbl(.Cells(p, "F"))
.Cells(p, "H") = 0
End If
Next
End With
Application.Calculation = xlCalculationAutomatic
End Sub 
PLİNT Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 16:23


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden