Public Sub AccountIncomeProduct()

    Dim cn As New ADODB.Connection
    Dim Sh As Worksheet
    Dim wb As Workbook
    Dim s As String
    Dim Count_Cell As Integer
    
    Count_Cell =  0 
    Set Sh = ActiveSheet
    
    cn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI; Persist Security Info=False;Initial Catalog=BPK_IncomeProduct;Data Source=B612-PC\MSSQLSERVER2008"
    'cn.ConnectionString = "Provider=SQLOLEDB.1;Password=pklbbm;Persist Security Info=True;User ID=Dimas;Initial Catalog=BPK_IncomeProduct;Data Source=B612-PC\MSSQLSERVER2008"

    cn.Open
    MsgBox ("Подключение к SQL Server выполнено! Выполняется расчет данных!")

    Dim strSQL As ADODB.Command
    Set strSQL = CreateObject("ADODB.Command")
    strSQL.ActiveConnection = cn
    strSQL.CommandType = adCmdText

    strSQL.CommandText = "SELECT " _
                            & "  [Процентная_ставка] " _
                            & " ,[Ставка_фондирования] " _
                            & " ,[Комиссия_за_выдачу] " _
                            & " ,[Ежемесячная_комиссия] " _
                            & " ,[Срок] " _
                            & " ,[Дисконт_RUR] " _
                            & " ,[Стоимость_PPI_RUR] " _
                            & " ,[Стоимость_АльфаХранителя_RUR] " _
                            & " ,[Доходность] " _
                            & " ,[Курс_USD] " _
                            & " ,[Продукт] " _
                            & " ,[Название_ТТ] " _
                            & " ,[Сумма_кредита_USD] " _
                            & " ,[Тип_ТТ] " _
                            & " ,[Область_Край] " _
                            & " ,[Сумма_кредита_RUR] " _
                            & " ,[Стоимость_PPI_RUR] " _
                            & " ,[Стоимость_АльфаХранителя_RUR] " _
                        & " FROM [BPK_IncomeProduct].[dbo].[IncomeProduct]" _
                        & " Where [Доходность] is Null " _
                        & "       and ([Ставка_фондирования] is not Null or [Процентная_ставка] is not Null " _
                        & "       or [Комиссия_за_выдачу] is not Null or [Ежемесячная_комиссия] is not Null)"


    Dim rs As New ADODB.Recordset
    Set rs.ActiveConnection = cn
    rs.CursorLocation = adUseClient
    rs.Open strSQL, , adOpenKeyset, adLockBatchOptimistic, adCmdText
    rs.MoveFirst
    
    
    '*********************************************************************************************

'MsgBox ("LabelAccounAllDB")
    Do Until rs.EOF
            
            If rs.Fields( 14 ) = "Москва" Then
                Cells( 6 ,  7 ) = "Москва"
            Else
                Cells( 6 ,  7 ) = "Регион"
            End If  'Область_Край
                       
            
            
            Cells( 12 ,  6 ) = rs.Fields( 12 )               'Сумма_кредита_USD
            Cells( 5 ,  7 ) = rs.Fields( 13 )                'Тип_ТТ
            Cells( 2 ,  2 ) = rs.Fields( 9 )                 'Курс_USD
            Cells( 9 ,  7 ) = rs.Fields( 10 )                'Продукт
            Cells( 45 ,  4 ) = rs.Fields( 11 )               'Название_ТТ
            
            
            Cells( 36 ,  4 ) = rs.Fields( 0 ) /  100           'Процентная_ставка
            Cells( 37 ,  4 ) = rs.Fields( 1 )                'Ставка_фондирования
            Cells( 39 ,  4 ) = rs.Fields( 2 )                'Комиссия_за_выдачу
            Cells( 40 ,  4 ) = rs.Fields( 3 ) /  100           'Ежемесячная_комиссия
            Cells( 41 ,  4 ) = rs.Fields( 4 )                'Срок
            Cells( 42 ,  4 ) = rs.Fields( 5 ) / rs.Fields( 15 ) 'Дисконт_RUR / Сумма кредита в руб.
            Cells( 43 ,  4 ) = rs.Fields( 16 )               'Стоимость_PPI_RUR
            Cells( 44 ,  4 ) = rs.Fields( 17 )               'Стоимость_АльфаХранителя_RUR
            
'            MsgBox (" Процентная_ставка - " & rs.Fields(0) & vbclr _
'            & " Курс_USD - " & rs.Fields(9) _
'            & " Ставка_фондирования - " & rs.Fields(1) * 100 _
'            & " Комиссия_за_выдачу - " & rs.Fields(2) _
'            & " Ежемесячная_комиссия - " & rs.Fields(3) _
'            & " Срок - " & rs.Fields(4) _
'            & " Дисконт_RUR - " & rs.Fields(5))
       
            ' Update данные в SQL
 
            rs![Доходность] = Cells( 31 ,  6 )
            rs.UpdateBatch
'        Cells(61 + Count_Cell, 61) = rs.Fields(8)
        
        Count_Cell = Count_Cell +  1 
        Cells( 2 ,  12 ) = Count_Cell ' Вывод счетчика обработанных записей

    rs.MoveNext
    Loop
    
'************************************************************************

    
    cn.Close
    MsgBox ("Отключение от SQL Serverвыполнено! Расчет выполнен успешно!")


End Sub

 29             Cells( 36 ,  4 ) = rs.Fields( 0 ) /  100  
---------------------------
Microsoft Excel
---------------------------
 13 : Type mismatch on line  29 
---------------------------
ОК   
---------------------------