Erkan Gegez
Yeni Üye
- Katılım
- 22 Eki 2021
- Mesajlar
- 25
- Aldığı beğeni
- 13
- Excel V
- Office 2019 TR
Konu Sahibi
Merhaba arkadaşlar,
B3 H8 arasındaki hücrelerden hangisine 1 rakamını yazarsam yazayım devamında sırasıyla 2,3,4 ... diye H8 e kadar sırayla yazsın istiyorum.Fakat sadece belirttiğim hücreler arasında bunu yapsın.Diğer hücrelerde yapmasın.
Bubun gibi aynı şeyi B11 H16 / B19 H24 / B27 H32 / B35 H40 / B43 H48 / B51 H56 / B59 H64 / B67 H72 / B75 H80 / B83 H88 / B91 H96
aralıklarında hangi hücreye 1 yazarsam devamında sırasıyla rakamları belirrttiğim sınırlar içine yazsın istiyorum.Bununla ilgili daha önceden bir konu açmıştım.Sayın askan cevaplamıştı ve aşağıdaki kodu göndermişti.Daha sonra B11 H16 arasında problem olduğunu fark ettim ,mesela B11 H16 arasında işliyor fakat B10 H10 arasında da 1 yazınca devamında 2,3,4... diye devam ediyor.Halbuki buralarda bu işlememeli sadece B11 H16 arası işlemeli. Diğer aralıklar normal çalışıyor...
İlgilenen arkadaşlara teşekkür ederim
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hücre As Range
Set Hücre = Range("B3:H97")
If Not Application.Intersect(Hücre, Range(Target.Address)) _
Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Dim a As Range
b = Empty
If WorksheetFunction.Find(":", Target.Address, 1) = Empty Then
b = Range("" & Replace(Target.Address, "$", "") & "")
Set b = Range("" & Replace(Target.Address, "$", "") & "")
Else
Set b = Range("" & Replace(Left(Target.Address, WorksheetFunction.Find(":", Target.Address, 1) - 1), "$", "") & "")
End If
If Len(b) > 0 Then
If Target.Value = 1 Then
k = 2
x = Target.Row: y = Target.Column
If x + 4 Mod 8 = 3 Or x + 4 Mod 8 = 2 Then GoTo son
devam:
y = y + 1
If y = 9 Then x = x + 1: y = 2
If x = 9 Or x = 18 Or x = 26 Or x = 34 Or x = 42 Or x = 50 Or x = 58 Or x = 66 Or x = 74 Or x = 82 Or x = 90 Or x = 98 _
Then GoTo son
Cells(x, y).Value = k
k = k + 1
GoTo devam
End If
End If
End If
son:
Application.EnableEvents = True
End Sub
B3 H8 arasındaki hücrelerden hangisine 1 rakamını yazarsam yazayım devamında sırasıyla 2,3,4 ... diye H8 e kadar sırayla yazsın istiyorum.Fakat sadece belirttiğim hücreler arasında bunu yapsın.Diğer hücrelerde yapmasın.
Bubun gibi aynı şeyi B11 H16 / B19 H24 / B27 H32 / B35 H40 / B43 H48 / B51 H56 / B59 H64 / B67 H72 / B75 H80 / B83 H88 / B91 H96
aralıklarında hangi hücreye 1 yazarsam devamında sırasıyla rakamları belirrttiğim sınırlar içine yazsın istiyorum.Bununla ilgili daha önceden bir konu açmıştım.Sayın askan cevaplamıştı ve aşağıdaki kodu göndermişti.Daha sonra B11 H16 arasında problem olduğunu fark ettim ,mesela B11 H16 arasında işliyor fakat B10 H10 arasında da 1 yazınca devamında 2,3,4... diye devam ediyor.Halbuki buralarda bu işlememeli sadece B11 H16 arası işlemeli. Diğer aralıklar normal çalışıyor...
İlgilenen arkadaşlara teşekkür ederim
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Hücre As Range
Set Hücre = Range("B3:H97")
If Not Application.Intersect(Hücre, Range(Target.Address)) _
Is Nothing Then
On Error Resume Next
Application.EnableEvents = False
Dim a As Range
b = Empty
If WorksheetFunction.Find(":", Target.Address, 1) = Empty Then
b = Range("" & Replace(Target.Address, "$", "") & "")
Set b = Range("" & Replace(Target.Address, "$", "") & "")
Else
Set b = Range("" & Replace(Left(Target.Address, WorksheetFunction.Find(":", Target.Address, 1) - 1), "$", "") & "")
End If
If Len(b) > 0 Then
If Target.Value = 1 Then
k = 2
x = Target.Row: y = Target.Column
If x + 4 Mod 8 = 3 Or x + 4 Mod 8 = 2 Then GoTo son
devam:
y = y + 1
If y = 9 Then x = x + 1: y = 2
If x = 9 Or x = 18 Or x = 26 Or x = 34 Or x = 42 Or x = 50 Or x = 58 Or x = 66 Or x = 74 Or x = 82 Or x = 90 Or x = 98 _
Then GoTo son
Cells(x, y).Value = k
k = k + 1
GoTo devam
End If
End If
End If
son:
Application.EnableEvents = True
End Sub