Arkadaşlar kolay gelsin sorunu bir türlü anlamıyorum Run ettiğimde çalışmayı durduruyor kodu aşağı bırakıyorum
Kod:
Dim a As Integer
Dim i As Long
Dim j As Long
Dim xrange2 As Range
a = 0
Dim b As Integer
b = 0
Dim i2 As Integer
Dim j2 As Integer
For i2 = 1 To 10
For j2 = 1 To 10
If Sheets("sayfa4").Cells(i2, j2) > 0 Then
b = b + 1
End If
Next j2
Next i2
While b > 0
i = Sheets("sayfa4").Cells(12, 1)
Set xrange2 = Sheets("sayfa4").Rows(i)
For j = 1 To 10
If Sheets("sayfa4").Cells(i, j) > 0 And Sheets("sayfa4").Cells(i, j) = Application.WorksheetFunction.Min(xrange2) Then
If (i = 1 And j = 10) Or (i = 2 And j = 9) Or (i = 7 And j = 8) Or (i = 10 And j = 1) Or (i = 9 And j = 2) Or (i = 8 And j = 7) Then
a = a + 1
Sheets("sayfa4").Cells(i, j).ClearContents
b = b - 1
Sheets("sayfa4").Cells(15 + a, 1) = i
Sheets("sayfa4").Cells(15 + a, 2) = j
Else
a = a + 1
Sheets("sayfa4").Cells(i, j).ClearContents
Sheets("sayfa4").Cells(j, i).ClearContents
b = b - 2
Sheets("sayfa4").Cells(15 + a, 1) = i
Sheets("sayfa4").Cells(15 + a, 2) = j
End If
End If
Sheets("sayfa4").Cells(12, 1) = j
Next j
Wend