• DİKKAT

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

Belirlenen son numarada makroyu durdurmak[çözüldü]

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
I

irfancantr

Altın Üye
Katılım
18 Haziran 2007
Mesajlar
625
Excel Vers. ve Dili
Excel 365 - İmngilizce
Merhaba değerli forum üyeleri,

Sayfa3 te A1 hücresinde ki değer değişirse makro1 devreye giriyor. Makro1'in son satırında ki kod ise A1 de bulunan sayı değerine 1 ekleme yapıyor. Bu yüzden makro durmadan devam ediyor. Ben A1 hücresinin koduna;
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$A$1" <> Empty Then Makro1
End Sub

nasıl bir ekleme yaparsam belirlediğim bir sayıda makroyu durdurabilirim.
Mesela limit sayı 3000 olabilir.

Buyrun bu da Makro1 kodu;
Kod: 
Sub Makro1()
Const AdresUrl As String = "http://www.motorsporlari.net/car/"
 Sheets("Sayfa3").Select
 Range("b3:c100").Select
    Selection.Clear
    'Selection.QueryTable.Delete
    Range("A2").Select

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;" & AdresUrl & [C1], Destination:=Cells(3, 2))
    
        .Name = "bmw-320d-advantage-i2284"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "4"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    
End With

Dim sat, a
sat = Range("K" & Rows.Count).End(xlUp).Row + 1
On Error Resume Next
Cells(sat, "L") = [C4].Value
Cells(sat, "M") = [C5].Value
Cells(sat, "N") = [C6].Value
Cells(sat, "O") = [C7].Value
Cells(sat, "P") = [C8].Value
Cells(sat, "Q") = [C9].Value
Cells(sat, "R") = [C10].Value
Cells(sat, "S") = [C11].Value
Cells(sat, "T") = [C14].Value
Cells(sat, "U") = [C15].Value
Cells(sat, "V") = [C16].Value
Cells(sat, "W") = [C17].Value
Cells(sat, "X") = [C18].Value
Cells(sat, "Y") = [C19].Value
Cells(sat, "Z") = [C20].Value
Cells(sat, "AA") = [C21].Value
Cells(sat, "AB") = [C22].Value
Cells(sat, "AC") = [C23].Value
Cells(sat, "AD") = [C24].Value
Cells(sat, "AE") = [C25].Value
Cells(sat, "AF") = [C26].Value
Cells(sat, "AG") = [C29].Value
Cells(sat, "AH") = [C30].Value
Cells(sat, "AI") = [C31].Value
Cells(sat, "AJ") = [C34].Value
Cells(sat, "AK") = [C35].Value
Cells(sat, "AL") = [C36].Value
Cells(sat, "AM") = [C37].Value
Cells(sat, "AN") = [C38].Value
Cells(sat, "AO") = [C39].Value
Cells(sat, "AP") = [C40].Value
Cells(sat, "AQ") = [C41].Value
Cells(sat, "AR") = [C42].Value
Cells(sat, "AS") = [C43].Value
Cells(sat, "AT") = [C44].Value
Cells(sat, "AU") = [C45].Value
Cells(sat, "AV") = [C46].Value
Cells(sat, "AW") = [C47].Value
Cells(sat, "AX") = [C48].Value
Cells(sat, "AY") = [C49].Value
Cells(sat, "AZ") = [C50].Value
Cells(sat, "BA") = [C51].Value
Cells(sat, "BB") = [C52].Value
Cells(sat, "BC") = [C53].Value
Cells(sat, "BD") = [C54].Value
Cells(sat, "BE") = [C55].Value
Cells(sat, "BF") = [C56].Value
Cells(sat, "BG") = [C57].Value
Cells(sat, "BH") = [C58].Value
Cells(sat, "BI") = [C59].Value
Cells(sat, "BJ") = [C60].Value
Cells(sat, "BK") = [C61].Value
Cells(sat, "BL") = [C62].Value
Cells(sat, "BM") = [C65].Value
Cells(sat, "BN") = [C66].Value
Cells(sat, "BO") = [C67].Value
Cells(sat, "BP") = [C68].Value
Cells(sat, "BQ") = [C69].Value
Cells(sat, "BR") = [C70].Value
Cells(sat, "BS") = [C71].Value
Cells(sat, "BT") = [C72].Value
Cells(sat, "BU") = [C75].Value
Cells(sat, "BV") = [C76].Value
Cells(sat, "BW") = [C77].Value
Cells(sat, "BX") = [C78].Value
Cells(sat, "BY") = [C81].Value
Cells(sat, "BZ") = [C82].Value
Cells(sat, "CA") = [C83].Value
Cells(sat, "CB") = [C84].Value
Cells(sat, "CC") = [C85].Value
Cells(sat, "CD") = [C86].Value
Cells(sat, "CE") = [C87].Value
Cells(sat, "CF") = [C88].Value
Cells(sat, "CG") = [C89].Value
Cells(sat, "CH") = [C90].Value
Cells(sat, "CI") = [C91].Value
Cells(sat, "CJ") = [C92].Value



a = Range("L" & Rows.Count).End(xlUp).Row: Range("K2") = 1
Range("K2:K" & a).DataSeries rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False

[a1].Value = [a1].Value + 1
End Sub
 

Ekli dosyalar

Son düzenleme:
Makro1 kodunu eklersen belki daha çabuk cevap alırsın.
Kota yüzünden indirme yapmadan cevaplamak daha iyi oluyor..
 
Şu şekilde deneyin..

Sub dene()
If [Sayfa3!A1] < 3001 Then
Makro1
End If
 
Bu kodu Modüle ekledikten sonra

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" <> Empty Then Makro1
End Sub

Yerine
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" <> Empty Then dene
End Sub

Yazdınızmı sorun çıkmaması lazım.
Web Bağlantını kontrol etmedim adreste sorun yoksa sorunsuz çalışması lazım..
 
Mustafa MUTLU' Alıntı:
Bu kodu Modüle ekledikten sonra

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" <> Empty Then Makro1
End Sub

Yerine
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" <> Empty Then dene
End Sub

Yazdınızmı sorun çıkmaması lazım.
Web Bağlantını kontrol etmedim adreste sorun yoksa sorunsuz çalışması lazım..
Genişletmek için tıkla ...

Bağlantıda bir sorun yok ama verdiğiniz kod hata verdi üstad :)
 
Sayın MUTLU makro1 ' in en başına
If [Sayfa3!A1] > 3000 Then Exit Sub
yazdım ve işlem istediğim gibi durdu ..

Verdiğiniz kod için çok teşekkür ederim.
 
irfancantr' Alıntı:
Sayın MUTLU makro1 ' in en başına
If [Sayfa3!A1] > 3000 Then Exit Sub
yazdım ve işlem istediğim gibi durdu ..

Verdiğiniz kod için çok teşekkür ederim.
Genişletmek için tıkla ...


Rica ederim..
Sorunu kendiniz çözdünüz..
Bizimki size fikir verdi sadece..
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst