- Katılım
- 14 Haziran 2006
- Mesajlar
- 129
Aşağıdaki kod Kaydet düğmesine bastığımda kaydetmesi gereken dosyayı açıyor ve d16:d65536 aralığına bakıyor TextBox9 da yazan şey bu aralıkda yazıyorsa var diye uyarı veriyor yoksa devam ediyor..
Uyarı verdi ise uyarı verdiği TextBox9 metni hangi satırda ise o satırın D ile Q hücresi aralığına MALIYET ANALIZI.xls dosyasının J25:W25 satırındakileri yazsın istiyorum..
Private Sub CommandButton1_Click()
Dim i As Integer
TextBox23.Value = ComboBox1.Value
Workbooks.Open ("\\Bsserver\Repair\ISLETME\Taşeron\Taşeron Performans\Taşerona Göre\2012\Atilla Deneme\" & TextBox23.Value & ".xls")
If WorksheetFunction.CountIf(Sheets("per").Range("d16:d65536"), TextBox9) > 0 Then
Workbooks(TextBox23.Value & ".xls").Close
i = Range("B75").End(xlUp).Offset(1, 0).Row ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Rows(i).Delete Shift:=xlUp
MsgBox "Önceden bu Taşeronu bu Gemi için değerlendirmişsiniz...", , "UYARI"
End ' UserForm u kapatır
Exit Sub
Else
On Error Resume Next
Workbooks("MALIYET ANALIZI.xls").Activate
Sheets("Toplam").Range("j100").End(xlUp).Offset(1, 0).Value = TextBox9.Value
Sheets("Toplam").Range("L100").End(xlUp).Offset(1, 0).Value = TextBox10.Value
Sheets("Toplam").Range("M100").End(xlUp).Offset(1, 0).Value = TextBox11.Value
Sheets("Toplam").Range("N100").End(xlUp).Offset(1, 0).Value = TextBox12.Value
Sheets("Toplam").Range("O100").End(xlUp).Offset(1, 0).Value = TextBox13.Value
Sheets("Toplam").Range("P100").End(xlUp).Offset(1, 0).Value = TextBox14.Value
Sheets("Toplam").Range("Q100").End(xlUp).Offset(1, 0).Value = TextBox15.Value
Sheets("Toplam").Range("R100").End(xlUp).Offset(1, 0).Value = TextBox16.Value
Sheets("Toplam").Range("S100").End(xlUp).Offset(1, 0).Value = TextBox17.Value
Sheets("Toplam").Range("T100").End(xlUp).Offset(1, 0).Value = TextBox18.Value
Sheets("Toplam").Range("U100").End(xlUp).Offset(1, 0).Value = TextBox19.Value
Sheets("Toplam").Range("V100").End(xlUp).Offset(1, 0).Value = TextBox20.Value
Sheets("Toplam").Range("W100").End(xlUp).Offset(1, 0).Value = TextBox21.Value
Sheets("Toplam").Range("J25:W25").Select
Selection.Copy
Windows(TextBox23.Value & ".xls").Activate
Sheets("per").Range("D100").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("per").Range("D100").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Windows("MALIYET ANALIZI.xls").Activate
Application.CutCopyMode = False
ActiveWindow.SmallScroll ToRight:=-5
Range("B25").Select
Windows(TextBox23.Value & ".xls").Activate
'Üst hücreyi alta kopyalar (ctrl+d)
Sheets("per").Range("R75").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.FillDown
Sheets("per").Range("S75").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.FillDown
Workbooks("MALIYET ANALIZI.xls").Activate
Sheets("Toplam").Range("b75").End(xlUp).Offset(1, 0).Value = TextBox23.Value
Application.CutCopyMode = False
End
ActiveWorkbook.Close True
End If
End Sub
Uyarı verdi ise uyarı verdiği TextBox9 metni hangi satırda ise o satırın D ile Q hücresi aralığına MALIYET ANALIZI.xls dosyasının J25:W25 satırındakileri yazsın istiyorum..
Private Sub CommandButton1_Click()
Dim i As Integer
TextBox23.Value = ComboBox1.Value
Workbooks.Open ("\\Bsserver\Repair\ISLETME\Taşeron\Taşeron Performans\Taşerona Göre\2012\Atilla Deneme\" & TextBox23.Value & ".xls")
If WorksheetFunction.CountIf(Sheets("per").Range("d16:d65536"), TextBox9) > 0 Then
Workbooks(TextBox23.Value & ".xls").Close
i = Range("B75").End(xlUp).Offset(1, 0).Row ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Rows(i).Delete Shift:=xlUp
MsgBox "Önceden bu Taşeronu bu Gemi için değerlendirmişsiniz...", , "UYARI"
End ' UserForm u kapatır
Exit Sub
Else
On Error Resume Next
Workbooks("MALIYET ANALIZI.xls").Activate
Sheets("Toplam").Range("j100").End(xlUp).Offset(1, 0).Value = TextBox9.Value
Sheets("Toplam").Range("L100").End(xlUp).Offset(1, 0).Value = TextBox10.Value
Sheets("Toplam").Range("M100").End(xlUp).Offset(1, 0).Value = TextBox11.Value
Sheets("Toplam").Range("N100").End(xlUp).Offset(1, 0).Value = TextBox12.Value
Sheets("Toplam").Range("O100").End(xlUp).Offset(1, 0).Value = TextBox13.Value
Sheets("Toplam").Range("P100").End(xlUp).Offset(1, 0).Value = TextBox14.Value
Sheets("Toplam").Range("Q100").End(xlUp).Offset(1, 0).Value = TextBox15.Value
Sheets("Toplam").Range("R100").End(xlUp).Offset(1, 0).Value = TextBox16.Value
Sheets("Toplam").Range("S100").End(xlUp).Offset(1, 0).Value = TextBox17.Value
Sheets("Toplam").Range("T100").End(xlUp).Offset(1, 0).Value = TextBox18.Value
Sheets("Toplam").Range("U100").End(xlUp).Offset(1, 0).Value = TextBox19.Value
Sheets("Toplam").Range("V100").End(xlUp).Offset(1, 0).Value = TextBox20.Value
Sheets("Toplam").Range("W100").End(xlUp).Offset(1, 0).Value = TextBox21.Value
Sheets("Toplam").Range("J25:W25").Select
Selection.Copy
Windows(TextBox23.Value & ".xls").Activate
Sheets("per").Range("D100").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("per").Range("D100").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Windows("MALIYET ANALIZI.xls").Activate
Application.CutCopyMode = False
ActiveWindow.SmallScroll ToRight:=-5
Range("B25").Select
Windows(TextBox23.Value & ".xls").Activate
'Üst hücreyi alta kopyalar (ctrl+d)
Sheets("per").Range("R75").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.FillDown
Sheets("per").Range("S75").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
Selection.FillDown
Workbooks("MALIYET ANALIZI.xls").Activate
Sheets("Toplam").Range("b75").End(xlUp).Offset(1, 0).Value = TextBox23.Value
Application.CutCopyMode = False
End
ActiveWorkbook.Close True
End If
End Sub