Vba üzerinden excel hücrelerine veri yazdırma

[spasmex97]

Arkadaşlar iyi günler excel hücreleri üzerine vba dan veri işleyerek bi kılavuz matrisi tarzında bir şeyler yapmaya çalışıyorum benim için önemli olan matris düzeninde verilen metnin hücrelere doğru algoritma ile yazılması
bu benim hangi sırayla ne işlemi yapması gerek algoritmam elbette eksikler vardır fakat sıkıntı şu ki j sayacı direk 1 den başlayıp teker ilerlemek yerine direk son değere ulaşıyor

bu resimde gördüğünüz verilerden benim j sayacım bu resimdeki satırları saymakla uğraşırken i sayacım ise "a" sütunu içerisindeki hücrenin sayısal değerini range olarak alıyor amacım i to i+hücre1 aralığında j,2 değerini sayfa1 de hücre(x,y) noktasına yazdırmak daha sonra hücre1 in sayısal değeri bittiğinde 2. satıra geçip i+hücre1 to i+hücre1+hücre2 aralığında bu sefer hücre(x,y) ye (for loopunda j 1'er olarak arttığı için +1 diye belirttim)(j+1,2) değerini yazdırmak olacak
fakat nedense j direk son hücreye gidip sadece sonra hücredeki değeri yazıyor ve başka hiçbir şey yapmıyor son hücredeki 64 tane yeşili işliyor fakat onuda tam doğru yapamıyorum
yani gidip son yeşili alıp onu doğru patternle yazdırmaya başlıyor ama maviden başlaması gerekiyor aslında

 

[Ömer]

Merhaba,

Örnek dosya ekleyerek açıklar mısınız.

Dosya Yükle - Dosya Upload

Dosyalarınızı ücretsiz yükleyebilir ve paylaşabilirsiniz. Dosya yükleme, Dosya Upload ücretsiz.

dosya.co

.

 

[spasmex97]

İndir caglikmakro

Dosyayı indir caglikmakro

dosya.co

 

[Ömer]

For i = bobin + 1 To bobin + iplik
x = 7 - Int(i / 45)
y = (45 - (i Mod 45))
Cells(x, y) = Sheets("sayfa2").Cells(j, 2)
Next i

Burada x ve y değeri aynı değerleri ürettiği(sadece + iplik değerine göre son değeri değişiyor) için verilerin tümü geliyor fakat üstüne yazdığı için son veri hücrede kalıyor. F8 ile kodun satır satır çalışma mantığını görebilir siniz.
Yazdırırken nasıl bir yol izlemek istiyorsunuz. Daha detaylı açıklarsanız, farklı bir yoldan gidilebilir.

 

[spasmex97]

yazdırırken sayfa 2 den çektiğim verilerden yola çıkarak 1. satırdaki adet sayısını döngüye range olarak sokup yanındak, "text" i cell(x,y) e yazdırmak istiyorum fakat i = 315 olduğunda bu döngünün durması gerekiyor orası eksik onu kavrayamadım tam
mantık şu sayfa2 deki adetlerin toplamı 224 , 224/2 = 112
bu 112 sayısı bana excel sayfasında kaçıncı satır ve sutün olduğunu vericek 7x45 lik düzende bu bana cell(3,22) yi veriyor bu da benim sayfa 2 deki ilk verim olan "mavi" yi cell(3,22) ye yazdırmam gerekiyor daha sonrasında 63 adet daha "mavi" yi (3,21) (3,20) ... (3,1) , (2,45) şeklinde yazdırmak istiyorum
112. verim tam olarak cell (1,1) de olmasını istiyorum

 

[Ömer]

Konuyu anlamaya çalışıyorum.
7 satır 45 sütunlu 315 hücreleri bir matris oluşturmaya çalışıyorsunuz.
mavi bittiğinde cell(3,22) (3,21) (3,20) ... (3,1) , (2,45) bu düzen; kırmızı için nasıl, sarı için vs.. nasıl işlemeli. Bu kısımla ilgili düşüncenizi anlayamadım.
Ayrıca ilk veriyi cells(3,21) yazıyor 22 ye değil.

 

[spasmex97]

+1 veya -1 gibi sayımlamada küçük hatalar var onları daha ince çalışıp düzelticem diğer textler içinde sarı kırmızı içinde aynı algoritmayla yazdırmaya devam edecek ki taa 112. veriyi yazdıktan sonra 113. veriden 224. veriye kadar artık başka bir 7x45 lik matriste işlenmesini istiyorum fakat daha oraya geçemedim
kusura bakmayın yeniyim bu konularda biraz aklımda olanı aktarmakta sıkıntı yaşıyorum

 

[spasmex97]

eğer birebir iletişim kurma fırsatımız varsa herhangi bir iletişim platformu ya da aracından daha anlaşılır bir şekilde ifade edebilirim sanırım

 

[Ömer]

Önemli değil, bende konuyu hala anlayamadım sizde kusura bakmayın

mavi için; (3,21) (3,20) ... (3,1) , (2,45) bitti.
kırmızı için; ..
sarı için; ...
.
.

hangi (?,?) numaralarla ilerlemesi gerekiyor, sanırım kilit tarafı burası. Bunu yazabilir misiniz.

Birde başlangıç satır sütunu için bulduğunuz (3,21) değerini nasıl hesapladınız. Bir mantığı var mı?

 

[spasmex97]

başlangıç değeri için aslında (3,22) olması gerekiyor zaten hata var diye belirtmiştiniz bu (3,22) değeri n/2 değerinden geliyor şu şekilde n= 224 durumu var n/2 = 112 ediyor 7x45 lik düzende 112 adeti işlediğim zaman 1,1 den 3,22 dahil dolu oluyor 1 satır 45 adet alıyor 2 satır + 3. satrın 22 adeti
hangi (?,?) gelince x ve y i sayesinde bulunuyor ve her i için x ve y değerleri tekrar hesaplanıyor ama algoritma olarak hücre doldurma mantığı önce sola (yani satırı dolduruyor ama sağdan gelerek) satır bittiğinde bir üst satıra geçip gidebileceği en sağ sütuna yani 45. sütuna gidiyor

 

[Ömer]

Netleşmesi için; (?,?) yerlerine kırmızı ve sarı için hangi sayılar gelmesi gerekiyor, sormak istediğim buydu.?

mavi için; (3,22) (3,21) (3,20) ... (3,1) , (2,45) bitti.
kırmızı için; .. (?,?) (?,?) (?,?) ... (?,?) , (?,?) bitti.
sarı için; ... (?,?) (?,?) (?,?) ... (?,?) , (?,?) bitti.

soru işaretleri yerine hangi sayılar gelmeli, doldurur musunuz.

 

[spasmex97]

soru işaretlerine şu sayılar gelmeli (3,22) den saymaya başlayan mavi (2,4) noktasında bittikten sonra (2,3) noktasından kırmızı 32 tane saymalı ve (1,17) de bitip (1,16) da sarı başlamalı

 

[dennyyss]

Kolay gelsin benimde bu tarz bir isle.e ihtiyacim var soyleki
Sayfa 1 de a, b ve c olmak uzere 3 sutunda 40. Satirlarina kadar verilerim var ve bu veriler surekli degiskenlik gosteriyor.
Ben sayfa1 uzerinde olusturulan AKTAR butonuna tiklayarak bu verileri sayfa 2 deki a, b ve c butonlarina aktarmak istiyorum. Yalniz diger bir aktar butonuna tiklandigi zaman bu sefer yine sayfa2 nin d, e ve f sutunlarina bunlari yazdirmak istiyorum. Her aktar butonuna tiklama sonrasinda sayfa 1 deki verilerin bulundugu a,b ve c sutunlarindaki degerlerin sifirlanmasi lazim l. Bu arada bos hucrelerin olmasi durumunda yine bos olarak karsilik gelen hucreye bos olarak aktarilllmasi lazım. Yardimci olursaniz cok memnun olurum simdiden tesekkur ederim.

 

[Ömer]

Merhaba,

Deneyiniz.

Sub aktar()

    Dim S1 As Worksheet, S2 As Worksheet, sut As Integer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    
    If WorksheetFunction.CountA(S2.Range("A1:C40")) = 0 Then
        sut = 1
    Else
        sut = S2.Rows("1:40").Find("*", , , , xlByColumns, xlPrevious).Column + 1
    End If
    
    S1.Range("A1:C40").Copy S2.Cells(1, sut)
    
    S1.Range("A1:C40").ClearContents
    Application.ScreenUpdating = True
    
End Sub

 

[dennyyss]

Omer bey oncelikle ilginiz icin cok tesekkur ederim.
Butona makroyu atadim. sayfa 1 de a ve b sutununa degerler yazip c sutununu ozellikle komple bos biraktim aktar dedigimde verileri istedigim gibi gonderdi ve sayfa2 deki c sutunu bostu ayrica sayfa 1 verileride silindi ancak sayfa1 den 2. Kez farkli verilerle aktar dedigimde sayfa1 deki degisik veri olan a sutunu verilerinin sayfa2 deki c sutununu doldurdugunu farkettim. Halbuki 3 lu bloklar halinde aktararak sayfa2 deki c sutununa degilde sayfa2 deki d sutunundan baslayarak yazmasi ve her aktarimda bu 3lu blogu takip etmesi gerekiyordu.
Diger bir noktada ise ben bu hucre degerlerini rastgelearada fonksiyonuyla ureterek aktardim ve sayfa2 deki aktarilan hucrelerin formullu oldugunu tespit ettim. Sizden ricam aktarilan bu degerlerin sadece sayidan ibaret olmasini ve formullerden arindirilmasini saglayabilirmisiniz. Tesekkur ederim

 

[dennyyss]

Omer bey yukarıda belirttiğim 3 lü blok halinde aktarma konusunu aktar butonuna kod ekleyerek ile boş yerlere 0 değeri atamak suretiyle hallettim. yalnız 2. bahsettiğim konuya müdahale edemiyorum yani formül ile birlikte aktarım yapıyor halbuki ben aktarılan verinin sadece değerlerinin aktarılmasını istiyorum. bu konuda yardımcı olabilirmisiniz. kodun son hali şu şekilde oldu;

Sub aktar()

Dim S1 As Worksheet, S2 As Worksheet, sut As Integer, deger As Range

Selection.Value = Selection.Value

For Each deger In Range("A1:C40")

If deger = "" Or deger = " " Then

deger.Value = "0"

Else

End If

Next deger

Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")

Application.ScreenUpdating = False

If WorksheetFunction.CountA(S2.Range("A1:C40")) = 0 Then
sut = 1
Else
sut = S2.Rows("1:40").Find("*", , , , xlByColumns, xlPrevious).Column + 1
End If

S1.Range("A1:C40").Copy S2.Cells(1, sut)

S1.Range("A1:C40").ClearContents
Application.ScreenUpdating = True

End Sub

 

[Ömer]

S1.Range("A1:C40").Copy S2.Cells(1, sut)

yukarıdaki satırın yerine aşağıdaki satırları yazarak deneyiniz.

S1.Range("A1:C40").Copy
S2.Cells(1, sut).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
Application.CutCopyMode = False

 

[dennyyss]

çok teşekkür ederim ömer bey elinize sağlık iyi çalışmalar