Çözüldü Koşullu biçimlendirilmiş veriyi kaydetmek

Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Merhaba arkadaşlar;

Excel Tablosunda ; B2:B1000 aralığındaki Arka plan rengi kırmızı olan verileri;

4 ile çarpıp, command buton ile nasıl kaydedebilirim ( C:\Deneme\ txt dosyasına..) ?

B2:B1000 hücre biçimi Metindir. Ama veri sayıdır.
 
Son düzenleme:

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,623
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Merhaba,

Aşağıdaki kodu dener misiniz.

Kod:
Const MyFile = "C:\TestFolder\Deneme.txt"
Sub ddd()

For Each deg In Range("b2:b1000")

If deg.DisplayFormat.Interior.ColorIndex = 3 Then tutar = tutar + CLng(deg) * 4

Next deg

    Open MyFile For Output As #1
        Print #1, Trim(tutar)
    Close #1

End Sub
 
Son düzenleme:
Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Erdem_34

Hocam kod çalışıyor ,dosyayı oluşturuyor... ama içeriği boş. veri yok.
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,623
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Örnek dosyanız koda uygun olmayabilir.
 
Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Örnek dosyanız koda uygun olmayabilir.
Evet , backround kırmızı değildi... işlemi yapmamış.;

Şimdi işlem yapılıyor ama toplama alıyor...

istenen;

örnek:

B2=15
B3=80
B4=40

diyelim.;

Deneme.txt dosyasında;

1. satır = 60
2. satır= 320
3. satır= 160

olması gerekiyor.
 
Son düzenleme:

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,623
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Bu kodu dener misiniz.

Kod:
Const MyFile = "C:\TestFolder\Deneme.txt"
Sub ddd()

    Open MyFile For Output As #1

For Each deg In Range("b2:b1000")

If deg.DisplayFormat.Interior.ColorIndex = 3 Then
        Print #1, deg.Value * 4
   End If

Next deg
Close #1

End Sub
 
Katılım
17 Haziran 2008
Mesajlar
1,871
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Altın Üyelik Bitiş Tarihi
26-03-2020
Erdem_34

Hocam Tamamdır... Elinize sağlık.
 
Üst