Attribute VB_Name = "update"
Public pnwrkODBC, pnwrkConnect, wrkResultSet

Sub Server_Connect()
    
'    Set pnwrkConnect = New ADODB.Connection
'    pnwrkConnect.ConnectionString = "DRIVER={SQL Server};SERVER=" + pnODBC + ";DATABASE=" + pndbNameSql + ";UID=" + pnLogin + ";PWD=" + decode_psw(pnParol) + ";DSN="
'    pnwrkConnect.Open
    Set pnwrkODBC = CreateWorkspace("SQL", _
        "adm", "", dbUseODBC)
    Set pnwrkConnect = pnwrkODBC.OpenConnection("SQL_CONNECT", _
        0, , _
        "ODBC;DRIVER={SQL Server};SERVER=" + "center" + ";DATABASE=" + "center_last" + ";UID=" + "adm" + ";PWD=" + "" + ";DSN=")
    pnwrkConnect.QueryTimeout = 0
End Sub

Public Sub check()
Dim sqlStr As String, i As Integer, j As Integer
Dim s, lnOper As Integer

Call Server_Connect

Set s = Sheets("Расход")

sqlStr = "SELECT [OPER]=R2.OPER, [SUMMA] = sum(r2.summa) , [NUMBER]=R1.NUMBER, [LINK] = R1.LINK " + _
            " into ##TAB" + _
            " from REM1 R1, REM2 R2, T_REM TR" + _
            " WHERE R1.LINK =TR.REM1 AND R2.LINK = TR.REM2 AND R1.DATE_EXEC = '" + s.Cells(1, 1).Text + "' AND R1.BACCOUNT = (SELECT LINK FROM S_ACCOUNT WHERE ACCOUNT = '" + VBA.Trim(s.Cells(2, 1).Text) + "')" + _
            " GROUP BY R1.LINK, R1.NUMBER, R2.OPER"
pnwrkConnect.Execute (sqlStr)

    j = 2
    While s.Cells(1, j) <> 999
        i = 4
        While VBA.Trim(s.Cells(i, 1).Text) <> ""
            If VBA.Trim(s.Cells(i, j).Text) <> "" And s.Cells(i, j).Comment Is Nothing Then
                sqlStr = "SELECT OPER FROM ##TAB WHERE NUMBER = '" + VBA.Trim(s.Cells(i, 1).Text) + "' AND SUMMA = " + Replace_in_Str(VBA.Trim(s.Cells(i, j).Value), ",", ".")
                Set wrkResultSet = pnwrkConnect.OpenRecordset(sqlStr, dbOpenDynaset)
                
                If wrkResultSet.RecordCount > 1 Then
                    s.Cells(i, j).Interior.ColorIndex = 10
                    GoTo nnn
                Else
                    If wrkResultSet.RecordCount = 0 Then 'попробуем без номера
                        sqlStr = "SELECT OPER FROM ##TAB WHERE SUMMA = " + Replace_in_Str(VBA.Trim(s.Cells(i, j).Value), ",", ".")
                        Set wrkResultSet = pnwrkConnect.OpenRecordset(sqlStr, dbOpenDynaset)
                        If wrkResultSet.RecordCount <> 1 Then
                            s.Cells(i, j).Interior.ColorIndex = 10
                            GoTo nnn
                        End If
                    End If
                End If
                lnOper = VBA.Trim(VBA.Str(wrkResultSet("OPER")))
                If lnOper <> s.Cells(1, j) Then
                    s.Cells(i, j).AddComment
                    s.Cells(i, j).Comment.Visible = False
                    s.Cells(i, j).Comment.Text Text:="старая:" & Chr(10) & VBA.Str(lnOper)
                End If
                s.Cells(i, j).Interior.ColorIndex = 34
            End If
nnn:
            i = i + 1
        Wend
        j = j + 1
    Wend
pnwrkConnect.Execute ("DROP TABLE ##TAB")

End Sub

Public Sub update()
Dim sqlStr As String, i As Integer, j As Integer
Dim s, lnOper As Integer, link As Long

Call Server_Connect

Set s = Sheets("Расход")

sqlStr = "SELECT [OPER] = r2.oper, [SUMMA] = sum(r2.summa) , [NUMBER]=R1.NUMBER, [LINK] = R1.LINK " + _
            " into ##TAB" + _
            " from REM1 R1, REM2 R2, T_REM TR" + _
            " WHERE R1.LINK =TR.REM1 AND R2.LINK = TR.REM2 AND R1.DATE_EXEC = '" + s.Cells(1, 1).Text + "' AND R1.BACCOUNT = (SELECT LINK FROM S_ACCOUNT WHERE ACCOUNT = '" + VBA.Trim(s.Cells(2, 1).Text) + "')" + _
            " GROUP BY R1.LINK, R1.NUMBER, R2.OPER"
pnwrkConnect.Execute (sqlStr)

    j = 2
    While s.Cells(1, j) <> 999
        i = 4
        While VBA.Trim(s.Cells(i, 1).Text) <> ""
            If VBA.Trim(s.Cells(i, j).Text) <> "" And s.Cells(i, j).Comment Is Nothing Then
                sqlStr = "SELECT OPER, LINK FROM ##TAB WHERE NUMBER = '" + VBA.Trim(s.Cells(i, 1).Text) + "' AND SUMMA = " + Replace_in_Str(VBA.Trim(s.Cells(i, j).Value), ",", ".")
                Set wrkResultSet = pnwrkConnect.OpenRecordset(sqlStr, dbOpenDynaset)
                
                If wrkResultSet.RecordCount > 1 Then
                    s.Cells(i, j).Interior.ColorIndex = 10
                    GoTo nnn
                Else
                    If wrkResultSet.RecordCount = 0 Then 'попробуем без номера
                        sqlStr = "SELECT OPER, LINK FROM ##TAB WHERE SUMMA = " + Replace_in_Str(VBA.Trim(s.Cells(i, j).Value), ",", ".")
                        Set wrkResultSet = pnwrkConnect.OpenRecordset(sqlStr, dbOpenDynaset)
                        If wrkResultSet.RecordCount <> 1 Then
                            s.Cells(i, j).Interior.ColorIndex = 10
                            GoTo nnn
                        End If
                    End If
                End If
                lnOper = VBA.Trim(VBA.Str(wrkResultSet("OPER")))
                link = VBA.Trim(VBA.Str(wrkResultSet("LINK")))
                
                If lnOper <> s.Cells(1, j) Then
                    s.Cells(i, j).AddComment
                    s.Cells(i, j).Comment.Visible = False
                    s.Cells(i, j).Comment.Text Text:="старая:" & Chr(10) & VBA.Str(lnOper)
                    
                    pnwrkConnect.Execute (" UPDATE REM2 SET OPER = " + VBA.Str(s.Cells(1, j)) + " WHERE LINK IN (SELECT REM2 FROM T_REM WHERE REM1 = " + VBA.Str(link) + ")")
                End If
                s.Cells(i, j).Interior.ColorIndex = 34
            End If
nnn:
            i = i + 1
        Wend
        j = j + 1
    Wend
pnwrkConnect.Execute ("DROP TABLE ##TAB")

End Sub


Public Function Replace_in_Str(ByVal lcTemplate As String, _
                            ByVal strWhat As String, _
                            ByVal strOnWhat As String) As String
Dim lnStartBegin As Integer, lnStartEnd As Integer, lnLenWhat As Integer
Dim lcExprLeft As String, lcExprRight As String
Dim TEMPLATE As String
    
TEMPLATE = lcTemplate
While VBA.InStr(1, TEMPLATE, strWhat, vbTextCompare) <> 0
    lnLenWhat = VBA.Len(strWhat)
    lnStartBegin = VBA.InStr(1, TEMPLATE, strWhat, vbTextCompare)
    lnStartEnd = lnStartBegin + lnLenWhat
    lcExprLeft = VBA.Left(TEMPLATE, lnStartBegin - 1)
    lcExprRight = VBA.Right(TEMPLATE, VBA.Len(TEMPLATE) - lnStartEnd + 1)
    TEMPLATE = lcExprLeft + strOnWhat + lcExprRight
Wend
Replace_in_Str = TEMPLATE

End Function


