Makro ile seri doldurma

dogu34

Altın Üye
Katılım
18 Ekim 2020
Mesajlar
72
Excel Vers. ve Dili
2007 Türkçe
Merhaba
A1 hücresine yazdığım rakamı belirli hücrelere seri doldurma yapmak istiyorum yardımcı olursanız sevinirim
Örnek;
A1 Hücresine A.001 yazdığımda buton yardımı ile C1 hücresine A.002, E1 hücresine A.003,G1 hücresine A.004
A2 Hücresine A.005,C2 hücresine A.006,E2 hücresine A.007
 

ÖmerFaruk

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
1,177
Excel Vers. ve Dili
Ofis 365 Türkçe
C++:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    On Error Resume Next
    Yazı = Left(Target.Value, 2)
    Sayı = Right(Target.Value, 3)
    If Not IsNumeric(Sayı) Then GoTo Son
    For i = 3 To 7 Step 2
        Cells(Target.Row, i) = Yazı & Format(Sayı + 1, "000")
        Sayı = Sayı + 1
    Next i
Son:
On Error GoTo 0
End Sub
 

dogu34

Altın Üye
Katılım
18 Ekim 2020
Mesajlar
72
Excel Vers. ve Dili
2007 Türkçe
Maalesef denedim ama olmadı.Yapmak istediğim A1 hücresine örneğin Ta.1000 yazdım ve butona tıkladım,C1 hücresine Ta.1001, E1 hücresine Ta.1002,G1 hücresine Ta.1003 şeklinde otomatik sıralama yapmak
 

ÖmerFaruk

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
1,177
Excel Vers. ve Dili
Ofis 365 Türkçe
Deneyin lütfen
C#:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Yazı As String
Dim myFormat As String

    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If InStr(1, Target.Value, ".") < 1 Then Exit Sub
    On Error GoTo Son
    Yazı = Left(Target.Text, InStr(1, Target.Text, "."))
    Sayı = Replace(Target.Text, Yazı, "")
    myFormat = WorksheetFunction.Rept(0, Len(Target.Value) - Len(Yazı))
    For i = 3 To 7 Step 2
        Cells(Target.Row, i) = Yazı & Format(Sayı + 1, myFormat)
        Sayı = Sayı + 1
    Next i
Son:
On Error GoTo 0
End Sub
 

dogu34

Altın Üye
Katılım
18 Ekim 2020
Mesajlar
72
Excel Vers. ve Dili
2007 Türkçe
Hocam teşekkürler denedim problem yok ama maalesef mantığı çözemedim zahmet olmazsa musait bir vaktinizde aşağıdaki şekilde uyarlayabilirmisiniz.Diğer hücrelere uyarlayabilirim diye düşünmüştüm o yüzden ilk örnekte tüm hücreleri yazmamıştım yardımcı olursanız sevinirim.
İlk numara B5 hücresine yazılacak diğer hücreler otomatik seri doldurma olacak
B5 D5 F5 H5 J5
B10 D10 F10 H10 J10
B15 D15 F15 H15 J15
B20 D20 F20 H10 J10
B25 D15 F15 H25 J25
Teşekkürler
 

ÖmerFaruk

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
1,177
Excel Vers. ve Dili
Ofis 365 Türkçe
C++:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Yazı As String
Dim myFormat As String
    If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub
    If InStr(1, Target.Value, ".") < 1 Then Exit Sub
    On Error GoTo Son
    Yazı = Left(Target.Text, InStr(1, Target.Text, "."))
    Sayı = Replace(Target.Text, Yazı, "")
    myFormat = WorksheetFunction.Rept(0, Len(Target.Value) - Len(Yazı))
    For k=5 to 25 step 5
    For i = 2 To 10 Step 2
        if k=5 and i=2 then Goto devam
        Cells(k, i) = Yazı & Format(Sayı + 1, myFormat)
        Sayı = Sayı + 1
Devam:
    Next i
    Next k
Son:
On Error GoTo 0
End Sub
 

dogu34

Altın Üye
Katılım
18 Ekim 2020
Mesajlar
72
Excel Vers. ve Dili
2007 Türkçe
Hocam teşekkürler elinize, emeğinize sağlık
 
Üst