MyTetra Share
Делитесь знаниями!
Изменение значения на нескольких листах
16.03.2019
23:43
Текстовые метки: vba,Изменение значения на нескольких листах
Раздел: !Закладки - VBA - Разобрать

Public Const strShMain As String = "d"

Public Const strShCalc As String = "D2;D3"


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

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

'

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

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.52
Яндекс индекс цитирования