Ö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.
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:
