• DİKKAT

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

Excel sayfasındaki birleştirilmiş veriyi not degerine aktarmak istiyorum makroyla

Dosyayı ekte görebilirsiniz. Kontrol edip sonuç bildirebilirseniz iyi olur. Kusura kalmayın mesai arasında biraz göndermesi sorunlu oldu.
 

Ekli dosyalar

Son düzenleme:
mAKRO DÜZENLEME

Sub txt_aktar1()
Dim hcr As Range, alan As String, say As Byte
Application.ScreenUpdating = False
alan = Sheets("KESİNTİ").Range("A4:A65536").SpecialCells(xlCellTypeConstants, 23).Address
Range("L4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("L4").Select
Open "C:\Documents and Settings\Zehni SAĞCAN\Belgelerim\KESİNTİ\İŞÇİ.TXT" For Output As #1
s = 1
For Each hcr In Sheets("KESİNTİ").Range(alan)
If s < 22 Then
Print #1, hcr.Offset(0, 11).Value
Else
Exit For
End If
s = s + 1
Next
Close
MsgBox "İŞÇİ KESİNTİSİ AKTARILDI"
End Sub
 
Ben gereken düzenlemeyi yaptım zehni bey.
s=1 değerini kabul etmiyor. onun için daha önce yazılan makro üzerinde biraz oynama yaptım.
 
hocam işçi ve sözleşmeli ikiside 23 satıra iniyor ama daha önceki gibi 33 satıra kadar inmiyor, yani en son yazdığı satırın sonunda bitmiyor
 
Son düzenleme:
ilgin için teşekür ederim exel.gen.tr deki hocalarım gerçekden yardım sever insanlarmış savolsunlar
 
satır 23 e kadar tanımlı, isterseniz sizdeki satır sayısına göre belirleyebilirsiniz. yada bir döngüyle son boş satıra kadar yapabilirsiniz.
 
mesala sözleşmeli için 22 satırın sonuna kadar yazdırabilme imkanı yokmu benim anladığım kadarıyla bir fonksiyon sürekli bir satır açıyor gibi geldi
 
Sub Iscitxt_aktar()
Dim hcr As Range, alan As String
Application.ScreenUpdating = False
alan = Sheets("KESİNTİ").Range("A4:A65536").SpecialCells(xlCellTypeConstants, 23).Address
Range("L4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("L4").Select

Open "d:\Belgelerim\Excel\İŞÇİ.TXT" For Output As #1
For Each hcr In Sheets("KESİNTİ").Range(alan)
say = say + 1
Print #1, hcr.Offset(0, 11).Value
For i = 4 To Cells(65536, 6).End(xlUp).Row
If say = i Then Exit For
Next
Next
Close
MsgBox "İŞÇİ KESİNTİSİ AKTARILDI"
End Sub
Sub Sozlesmelitxt_aktar()
Dim hcr As Range, alan As String
Application.ScreenUpdating = False
alan = Sheets("KESİNTİ").Range("A4:A65536").SpecialCells(xlCellTypeConstants, 23).Address
Range("F4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F4").Select

Open "d:\Belgelerim\Excel\SÖZLEŞMELİ.TXT" For Output As #1
For Each hcr In Sheets("KESİNTİ").Range(alan)
Print #1, hcr.Offset(0, 5).Value
For i = 4 To Cells(65536, 12).End(xlUp).Row
If say = i Then Exit For
Next
Next
Close
MsgBox "SÖZLEŞMELİ KESİNTİSİ AKTARILDI"
End Sub
Genişletmek için tıkla ...
kodları bu şekilde düzenleyin
 
Şu an ona uğraşıyorum işin içine döngü girince biraz iş karıştı.
 
yardım

evren gizlen hocam not defterindeki fazla giden satırı silme sorunum için yardımcı olurmusunuz.
 
Sn. zehnisağcan dosyayı ekliyorum. döngü sorun çıkartıyor. Yalnız a4:a65536 aralığı verildiği için bu arada bakacaktır. eğer satır artırma durumu söz konusu olursa Iscitxt_aktar makrosundaki değeri ona göre artırarak boşluk oluşmasını engelleyebilirsiniz.
Kolay gelsin.
 

Ekli dosyalar

Ben anlamıyorum.Nasıl 21 satırı aşıyor.
makroyu çalıştırın ve satırları sayın.Eğer 22 satır sayıyorsanız başkasına saydırın.
Kırmızı satoırdaki yolu siz kendinize uyarlayın.Dosyadad öyle
Dosya ekte.:cool:
Kod: 
Option Explicit
Sub txt_aktar1()
Dim hcr As Range, alan As String, say As Byte
Application.ScreenUpdating = False
alan = Sheets("KESİNTİ").Range("A4:A65536").SpecialCells(xlCellTypeConstants, 23).Address
Range("L4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("L4").Select

'Open "C:\Documents and Settings\Zehni SAĞCAN\Belgelerim\KESİNTİ\İŞÇİ.TXT" For Output As #1
[B][COLOR="Red"]Open "C:\İŞÇİ.TXT" For Output As #1[/COLOR][/B]

For Each hcr In Sheets("KESİNTİ").Range(alan)
say = say + 1
Print #1, hcr.Offset(0, 11).Value
If say = 21 Then Exit For
Next
Close
MsgBox "İŞÇİ KESİNTİSİ AKTARILDI"
End Sub
 

Ekli dosyalar

Evren bey sizin kodlardan kaynaklanan birşey değil. Şu mantıkla yola çıktık, eğer hücre sayısı daha fazla ise örneğin 2000 satırıdan oluşuyor. dolayısıyla sizin satıra eşitlediğiniz 21 değerinde kalacaktır. devamındaki satırları okumayacaktır düşüncesinden hareketle bir çözüm olabilir mi yönünde sonuç üretmeye çalıştık. Yani satır sayısı değişken olursa ne olur
 
Mx@Raid' Alıntı:
Evren bey sizin kodlardan kaynaklanan birşey değil. Şu mantıkla yola çıktık, eğer hücre sayısı daha fazla ise örneğin 2000 satırıdan oluşuyor. dolayısıyla sizin satıra eşitlediğiniz 21 değerinde kalacaktır. devamındaki satırları okumayacaktır düşüncesinden hareketle bir çözüm olabilir mi yönünde sonuç üretmeye çalıştık. Yani satır sayısı değişken olursa ne olur
Genişletmek için tıkla ...
İyide 21 satır istiyor.
O zaman soruyu yanlış soruyor.
Ben sizin dediğinizden bir şey anlamadım.
Ne isteniyor son dolu satıra kadar dolu satırları txt dosyazına yazsınmı istiyor.
Ne istiyor.
Bilmeden nasıl yapacağız.
Biraz açıklama yaparsanız bir şeyler yaparız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst