daha önce çalışan bir dosyam idi şimdi hata veriyo ve soru işareti olan bölümü sarı işaretliyor yardım dosya ekte
Sub onalti()
Dim Syl(1 To 7)
For i = 1 To Range("A65536").End(3).Row
For a = 1 To 7
Syl(a) = Mid(Cells(i, "A").Value, a, 1) * 1??????
Cells(i, a + 1).Value = Syl(a)
Next a
For b = 2 To 6 Step 2
If Len(Syl(b) * 2) = 2 Then
Syl(b) = Mid(Syl(b) * 2, 1, 1) * 1 + Mid(Syl(b) * 2, 2, 1) * 1
Else
Syl(b) = Syl(b) * 2
End If
Next b
deger = (Syl(1) + Syl(2) + Syl(3) + Syl(4) + Syl(5) + Syl(6) + Syl(7)) * 1
algrt = (Int((deger / 10) + 1) * 10) - deger
If algrt = 10 Then
algrt = 0
End If
Cells(i, "I").Value = algrt
Cells(i, "J").Value = "'" & Cells(i, "A").Value & algrt
Next i
End Sub
Sub onalti()
Dim Syl(1 To 7)
For i = 1 To Range("A65536").End(3).Row
For a = 1 To 7
Syl(a) = Mid(Cells(i, "A").Value, a, 1) * 1??????
Cells(i, a + 1).Value = Syl(a)
Next a
For b = 2 To 6 Step 2
If Len(Syl(b) * 2) = 2 Then
Syl(b) = Mid(Syl(b) * 2, 1, 1) * 1 + Mid(Syl(b) * 2, 2, 1) * 1
Else
Syl(b) = Syl(b) * 2
End If
Next b
deger = (Syl(1) + Syl(2) + Syl(3) + Syl(4) + Syl(5) + Syl(6) + Syl(7)) * 1
algrt = (Int((deger / 10) + 1) * 10) - deger
If algrt = 10 Then
algrt = 0
End If
Cells(i, "I").Value = algrt
Cells(i, "J").Value = "'" & Cells(i, "A").Value & algrt
Next i
End Sub
Ekli dosyalar
Son düzenleme:
