• DİKKAT

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

kod düzeltmesi YARDIM

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,986
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Herkese merhabalar;

Aşağıdaki kod hesaplama sonuçlarını F sütunundan başlayarak sütun atlayarak yazıyor.

Kodun atladığı sütunlara (E sütunundan başlayarak)
hesaplamada kullanmak üzere I.KU sayfasında bulduğu kalıp adını yazdırmak
için kodda hangi değişikliği yapmalıyım ?

Excel belgemi mesaja ekledim.


Kod:
Dim q As Long
Sub uretim()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet

Set s1 = ThisWorkbook.Worksheets("üretim")
Set s2 = ThisWorkbook.Worksheets("üretim.BİRİM İŞLEM")
Set s3 = ThisWorkbook.Worksheets("I.KU")

s1n = s1.[A65536].End(3).Row
s2n = s2.[A65536].End(3).Row + 1
s3n = s3.[A65536].End(3).Row
s2.Range("a3:e" & s2n + 1).ClearContents
For q = 7 To 43 Step 2
     s2.Range(Clmn(q) & 3 & ":" & Clmn(q) & s2n).ClearContents
Next q
    For i = 2 To s1n
         If WorksheetFunction.Match(s1.Cells(i, "a"), s3.[a:a], 0) Then 'i.ku sayfasında arar
            iku_sat = WorksheetFunction.Match(s1.Cells(i, "a"), s3.[a:a], 0) 'satır
            iku_sut = WorksheetFunction.CountA(s3.Range("b" & iku_sat & ": u" & iku_sat)) 'dolu sütun
                   s2.Cells(i + 1, "a") = s1.Cells(i, "a") 'ürün
                   s2.Cells(i + 1, "b") = s1.Cells(i, "b") 'ürün
                   s2.Cells(i + 1, "c") = s1.Cells(i, "c") 'ürün
                   s2.Cells(i + 1, "d") = s1.Cells(i, "d") 'ürün
                   a = 0
               For j = 1 To iku_sut 'kalıp kadar işlem yapar
                   islem = sure_bul(s3.Cells(iku_sat, j + 1)) * s1.Cells(i, "b") 'süre * miktar
                   s2.Cells(i + 1, 5 + j + a) = islem 'sütun başlangıç + 1 sütun atlama
                   a = a + 1
               Next j
         End If
    Next i

Set s1 = Nothing: Set s2 = Nothing: Set s3 = Nothing
End Sub
Function sure_bul(kalip As String) As Integer
Dim s4 As Worksheet
Set s4 = ThisWorkbook.Worksheets("K")
    If WorksheetFunction.Match(kalip, s4.[a:a], 0) Then
       sure_bul = s4.Cells(WorksheetFunction.Match(kalip, s4.[a:a], 0), "c") 'süre
    End If
Set s4 = Nothing
End Function
Function Clmn(ColumnNumber As Long) As String
    Dim strLetters As String
    strLetters = Cells(1, ColumnNumber).Address(1, 0)
    Clmn = Left(strLetters, InStr(1, strLetters, "$") - 1)
End Function
 
Son düzenleme:
s2.Cells(i + 1, 4 + j + a) = islem 'sütun başlangıç + 1 sütun atlama
a = a + 1
Açıklama kısmına yazılmış sutun atlama işlemi 4+J+A kısmını 4+J olarak değiştirip denermisiniz +a işlemini kaldırın.
 
Teşekkür ve yeni bir rica.

Belgemi eklemeyi unutmuşum, şimdi ekliyorum.

Yukarıdaki kod hesaplama sonuçlarını F sütunundan başlayarak sütun atlayarak yazıyor.

Kodun atladığı sütunlara (E sütunundan başlayarak)
kodun hesaplamada kullanmak üzere I.KU sayfasında bulduğu
kalıp adını yazdırmak için kodda hangi değişikliği yapmalıyım ?


Yani örneğin;
- U_02 isimli ürünün satırında E4 hücresine
I.KU sayfasındaki B3 hücresindeki kalıp adını,

- U_02 isimli ürünün satırında G4 hücresine
I.KU sayfasındaki C3 hücresindeki kalıp adını,

yazdırmam lazım.

Tabi bu işlem E sütunundan başlayarak AQ sütununa kadar devam ediyor.

İlginiz için teşekkürler.
 
Son düzenleme:
Lütfen 3 no'lu mesaj içeriğine göre yardımcı olur musunuz?

Zira kod işinden pek anlamıyorum. Birkaç şey denedim ama olmadı maalesef.
 
Tam olarak budur ricam Hüseyin Bey çok çok sağ olunuz.
Farkına yeni varıyorum benim diğer sorumla da siz uğraşıyorsunuz.
Diğer konuyla bu konu bütünün parçalarıdır, fark etmişsinizdir siz de.

Çok zahmet vermiyorum umarım.
 
Geri
Üst