Makro kodda değişiklik

[Ömer BARAN]

Kod yazmayı bilen arkadaşlar yardımcı olamaz mı acaba?

Sorunum çalışan bu makroyu belgemde başka sayfada kullanabilmek.

Aradaki tek fark makronun çalışacağı sayfanın yapısı.

--Makroyu yeni sayfamın başka bir sütununa ( M yerine G ),
--Başka bir satırdan başlayarak ( 7'nci yerine 3'üncü satırdan itibaren )
veri yazar hale getirmem gerekiyor.
Ricam sadece aşağıdaki kod'un çalıştığı sayfayı değiştirebilmek (Bu kısmı sonradan ekledim.).

Aşağıdaki koda
(daha önce açtığım bir konu için - http://www.excel.web.tr/f48/secenekler-arasyndan-secim-t127025/sayfa2.html - bir forum üyesi -Huseyinkis- arkadaş yazdı) aynı belgenin başka sayfasında kullanabilmek için müdahale etmeye kalkıştım ama beceremedim sanırım.

Bu kod belgemin "makineata" sayfasında işlem yapıyordu.

Kodun çalıştığı makineata sayfasından bahsetmem gerek sanırım.
--A sütunu boş idi,
--Kod M7 'den başlayarak M sütununa veri yazıyordu,
--Kod belgemin başka sayfalarındaki verilerle, bu sayfanın E sütunundaki verileri (E7'den itibaren) karşılaştırarak işlem yapıyordu.

Aynı kodu şimdi belgemin üretim2 sayfasında kullanmak istiyorum ancak;

üretim2 sayfasında;
--A sütunu dolu,
--Kodun veri yazacağı sütun G3 'ten başlayarak G sütunu,
--Kod belgemin başka sayfalarındaki verilerle karşılaştırmada kullanacağı veriler bu kez de E sütununda (E3 ten itibaren).

Kodda hangi değişiklikleri yapmak gerekir acaba?

Yardımcı olursanız sevinirim.
İlgilenenlere teşekkürler.

[SIZE="2"]Sub MakineSec()

Set s1 = Sheets("04.kal-mak eşleşmesi")
Set s2 = Sheets("HESAP")

son = s2.Cells(Rows.Count, 2).End(3).Row
For i = 7 To son

satr = s1.Range("A1:A550").Find(s2.Cells(i, 5).Value, LookIn:=xlValues, LookAt:=xlPart).Row

If Not s2.Cells(i, 5).Value = "" Then
If s1.Cells(satr, 57).Value = 1 Then
For x4 = 2 To 56
If s1.Cells(satr, x4).Value <> "" Then
s2.Cells(i, 13).Value = s1.Cells(satr, x4).Value
End If
Next x4
End If
End If
Next

For xx = 2 To 11
For x1 = 7 To son
Adet = 500
konum = 0
işlem = 0
satr = s1.Range("A1:A550").Find(s2.Cells(x1, 5).Value, LookIn:=xlValues, LookAt:=xlPart).Row

If xx = 11 Then
işlem = 5
ElseIf s1.Cells(satr, 57).Value = xx Then
işlem = 5
End If

If işlem = 5 Then
If s2.Cells(x1, 5).Value <> "" And s2.Cells(x1, 13).Value = "" Then
For x2 = 2 To 56
If s1.Cells(satr, x2).Value <> "" Then
say = WorksheetFunction.CountIf(s2.Range("M7:M" & son), s1.Cells(satr, x2).Value)
If say < Adet Then
Adet = say
konum = x2
End If
End If
Next x2
s2.Cells(x1, 13).Value = s1.Cells(satr, konum).Value
End If
End If

Next x1

Next xx

End Sub[/SIZE]

 

[Ömer BARAN]

Kod yazmayı bilen arkadaşlar yardımcı olamaz mı acaba?

Makro çalışan bir makro.

Sorunum başka sayfaya göre kodlanmış aynı makroyu başka sayfada kullanabilmek.

Aradaki tek fark makronun çalışacağı sayfanın yapısı farklı.

Makronun veri yazacağı sayfadaki sütun ve satırlar farklı sadece.

 

[Ömer BARAN]

Kod yazabilen arkadaşların yardımını bekliyorum.
Teşekkürler.

 

[Ömer BARAN]

İlk mesaja bakınız lütfen.

Kod yazabilen arkadaşların yardımını bekliyorum.

Teşekkürler.

 

[Ömer BARAN]

Lütfen bir arkadaşımız yardımcı olsun.

Kod yazmayı bilen arkadaşlar yardımcı olamaz mı acaba?

Sorunum çalışan bu makroyu belgemin başka sayfasında kullanabilmek.

Aradaki tek fark makronun çalışacağı sayfanın yapısı.

Makroyu yeni sayfamın başka bir sütununa ( M yerine G ), başka bir satırdan başlayarak ( 7'nci yerine 3'üncü satırdan itibaren ) veri yazar hale getirmem gerekiyor.

Ya kod yazmayı bilen arkadaşlar şu an sitede değil ya da sorunumun halli çok zor.

Bir arkadaşımız bir el atsa benim konuya.

Lütfen bir arkadaşımız yardımcı olsun.

 

[Seyit Tiken]

Ömer bey, şimdiye kadar sorunuza yanıt gelmemesinin nedeni(bana göre), çok karışık ve geniş kapsamlı bir şekilde sormanızdır. Dosya da eklememişsiniz, soruyu(veya soruları) ne kadar net ve kısa sorarsanız o kadar çabuk ve net cevap alırsınız. Benim tavsiyem, program yapıyorsanız, bunu adım adım ve soruları tek tek sorunuz, tümevarım mantığıyla soru sorarsanız hedefinize çabuk ulaşırsınız diye düşünüyorum.

 

[türkgülü]

Anladığım kadarıyla bazı değişiklikler yaptım umarım olmuştur. Eski kodların yerine komple bunları yapıştırın.

Sub MakineSec()

Set s1 = Sheets("04.kal-mak eşleşmesi")
Set s2 = Sheets("HESAP")

son = s2.Cells(Rows.Count, 2).End(3).Row
For i = 3 To son

satr = s1.Range("A1:A550").Find(s2.Cells(i, 5).Value, LookIn:=xlValues, LookAt:=xlPart).Row

If Not s2.Cells(i, 5).Value = "" Then
If s1.Cells(satr, 57).Value = 1 Then
For x4 = 2 To 56
If s1.Cells(satr, x4).Value <> "" Then
s2.Cells(i, 7).Value = s1.Cells(satr, x4).Value
End If
Next x4
End If
End If
Next

For xx = 2 To 11
For x1 = 3 To son
Adet = 500
konum = 0
işlem = 0
satr = s1.Range("A1:A550").Find(s2.Cells(x1, 5).Value, LookIn:=xlValues, LookAt:=xlPart).Row

If xx = 11 Then
işlem = 5
ElseIf s1.Cells(satr, 57).Value = xx Then
işlem = 5
End If

If işlem = 5 Then
If s2.Cells(x1, 5).Value <> "" And s2.Cells(x1, 7).Value = "" Then
For x2 = 2 To 56
If s1.Cells(satr, x2).Value <> "" Then
say = WorksheetFunction.CountIf(s2.Range("M7:M" & son), s1.Cells(satr, x2).Value)
If say < Adet Then
Adet = say
konum = x2
End If
End If
Next x2
s2.Cells(x1, 7).Value = s1.Cells(satr, konum).Value
End If
End If

Next x1

Next xx

End Sub

 

[türkgülü]

Bu arada kodları sizin yaptığınız gibi pencereden göndermeyi beceremedim. Kusura bakmayın.