MyTetra Share
Делитесь знаниями!
m_Plus_Minus
Время создания: 16.03.2019 23:43
Текстовые метки: Plus_Minus, плюс_минус
Раздел: !Закладки - VBA - Excel - Cells

'Public Const strShMain As String = "PHC_6a"

'Public Const strShCalc As String = "PHC_6a"

 

' =====================================================================================

' ##### Изменение значения на нескольких листах

'

' -------------------------------------------------------------------------------------

'Sub test_Plus_Minus()

''    strShMain = "d"

''    strShCalc = "D2;D3"

''    strCalc = "+"

'    Plus_Minus strShMain, strShCalc, "A1", "+"

'End Sub

Sub Plus_Minus(ByVal strShMain As String, _

                    ByVal strShCalc As String, _

                        ByVal strRange As String, _

                        ByVal strCalc As String)

Dim vVal As Variant 'FnSh_Exist

Dim m, strShTemp As String

 

EventsChange False

 

With ThisWorkbook

    vVal = .Sheets(strShMain).Range(strRange).Value

    Select Case strCalc

        Case "+": vVal = .Sheets(strShMain).Range(strRange).Value + 1

        Case "-": vVal = .Sheets(strShMain).Range(strRange).Value - 1

    End Select

    .Sheets(strShMain).Range(strRange).Value = vVal

 

    m = Split(strShCalc, ";", -1, vbTextCompare)

    For i = LBound(m) To UBound(m)

        strShTemp = Trim(m(i))

        If FnSh_Exist(ThisWorkbook, strShTemp) Then .Sheets(strShTemp).Range(strRange).Value = vVal

    Next i

End With

 

EventsChange True

 

End Sub

' =====================================================================================

 

' =====================================================================================

' ##### существует ли лист в книге

'

' -------------------------------------------------------------------------------------

Function FnSh_Exist(oWb As Workbook, sName As String) As Boolean

    Dim wsSh As Worksheet

    On Error Resume Next

    Set wsSh = oWb.Sheets(sName)

    FnSh_Exist = Not wsSh Is Nothing

End Function

' =====================================================================================

Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования