Değişik bir veri aktarımı

[ckayaz]

Gerek sayfa içi aktarımlar gerekse sayfalar arası aktarımları inceledim ve araştırdım ama nedense istediğimi bulamadım. Şimdi iki sayfam var 1 sayfam veri sayfası diğer sayfam sınıflandırma sayfası Veri sayfasındaki illerikarşısına sayı yazdığım zaman bunları sınıflandırma sayfasına aktarsın.
Örneğin veri sayfasında 1. sırada b3 sütununda yer alan ANKARA-B.B. karşısında yazan sayıları sınıflandırma sayfasına yine sınıflandırma sayfasında ANKARA-B.B. olduğu kadar yazdırsın. F3 sütununda yazan sayı kadarda olabilir veya saınıflandırma sayfasında yazan il kadarda olabilir. Bunu makroyla yapmak istiyorum Yardımlarınız için şimdiden teşekkür ederim

 

[asi_kral]

Merhaba
Peki tüm liste mi bu şekilde olacak. Böyle olacak ise excel de satır sorunu yaşayabilirsiniz.
Excel 2007 alt sürümlerinde 65.536 satır
Excel 2007 ve üstü sürümlerde ise 1.048.576 satır mevcut. Sıkıntı olmaz derseniz kodu yazabilirim diye düşünüyorum.

 

[ckayaz]

Sayın asi_kral ilginizden dolayı teşekkür ederim veri sayfasına il ve ilçe sayısı en az 3 en fazla 100 tane yazılacak sınıflandır sayfasına 30 ar tane atsa 90 veya 3000 satır yapar. kaldıki bu sayı 5000 satırı geçmez. zaten ankara gördüğü zaman ankara satırına sayıları rastgele atmayacak. Ankara mamak sa ankara mamak sütunlarına dağıtacak ankara ulus ankara ulus sütunlarına dağıtım yapacak. veri sayafasında f sütununda en azla olsa olsa 40 yazılabilir 40 tanede yazılsa 4000 satır yapar. f sunundaki bu sayı en az 10 en fazla 40 olabilir.

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, STR1 As Long, CPY As Long
Application.ScreenUpdating = False
Set S1 = Sheets("SINIFLANDIR")
Set S2 = Sheets("VERİ")
S1.Range("G4:G" & Rows.Count).ClearContents
S1.Range("J4:L" & Rows.Count).ClearContents
For STR = 3 To S2.Range("B" & Rows.Count).End(xlUp).Row
STR1 = S1.Range("G" & Rows.Count).End(xlUp).Row + 1
CPY = Left(S2.Cells(STR, "F"), InStr(1, S2.Cells(STR, "F"), " ", vbTextCompare) - 1)
S1.Range("G" & STR1 & ":G" & CPY + STR1 - 1) = S2.Cells(STR, "B")
S1.Range("J" & STR1 & ":J" & CPY + STR1 - 1) = S2.Cells(STR, "C")
S1.Range("K" & STR1 & ":K" & CPY + STR1 - 1) = S2.Cells(STR, "D")
S1.Range("L" & STR1 & ":L" & CPY + STR1 - 1) = S2.Cells(STR, "E")
Next
Application.ScreenUpdating = True
MsgBox "İşlem Sonucu"
End Sub

 

[ckayaz]

Dağıtma süresi biraz uzun sürüyor ama inanki muhteşem olmuş, ben onu dağıtmak için kaç hafta uğraştım bir bilsen şaşırırsın. Dosya boyutunu 300 kb azaltmış olduk. Eline aklına klavyene sağlık Allah uzun ömür versin

Bir sorunum daha olacak 20 sayfam var düşeyara ile sınıflandır sayfasından veri alıyor, düşeyara formülünü makroya çevirebilirmiyiz?

 

[asi_kral]

Dağıtma süresi biraz uzun sürüyor ama inanki muhteşem olmuş, ben onu dağıtmak için kaç hafta uğraştım bir bilsen şaşırırsın. Dosya boyutunu 300 kb azaltmış olduk. Eline aklına klavyene sağlık Allah uzun ömür versin

Bir sorunum daha olacak 20 sayfam var düşeyara ile sınıflandır sayfasından veri alıyor, düşeyara formülünü makroya çevirebilirmiyiz?

Kolay Gelsin.

Sorunuza gelince yeni konu açın örnek dosyanızı ekleyin sonuçlara bakarız olursa kodu ekleriz.