VPF::[VBA] Работа с объектом CELLS - Форум программистов

termik

Дата 2.5.2007, 00:22 (ссылка)

(нет голосов)

Загрузка ...

КотеГ

Профиль
Группа: Участник
Сообщений: 817
Регистрация: 20.11.2005

Репутация: нет
Всего: 33

Заменить все "," на "." (либо наоборот) в ячейках, содержащих число. Отменить изменения. Посчитать итоговую сумму для каждого столбца начиная с H.
Прокомментируете пожалуйста и исходник smile

ama_kid

Дата 2.5.2007, 11:21 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95

Наверное, навскидку примерно так:
Код приведенный ниже помещаешь в отдельный модуль:

Код

'Собственный тип для Undo
    Type SaveRange
        Val As Variant
        Addr As String
    End Type
    
'   Сохраняем инфу для Undo
    Public OldWorkbook As Workbook
    Public OldSheet As Worksheet
    Public OldSelection() As SaveRange

Public Sub SaveBeforeAction()
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    ReDim OldSelection(Selection.Count)
    Set OldWorkbook = ActiveWorkbook
    Set OldSheet = ActiveSheet
    i = 0
    For Each cell In Selection
        i = i + 1
        OldSelection(i).Addr = cell.Address
        OldSelection(i).Val = cell.Formula
    Next cell
End Sub

Public Sub DoAction()
 SaveBeforeAction
 If TypeName(Selection) <> "Range" Then Exit Sub

 If Selection.Count = 1 Then
  MsgBox "Надо выделить диапазон ячеек"
  Exit Sub
 End If
 Dim i As Integer
 Dim ReadItem As Object
 Dim Sum As Double
 Dim DecimalSeparator As String
 Dim NonDecimalSeparator As String
 Dim Stroka As String
 Set ReadItem = ThisWorkbook.Sheets("Лист1")
 Sum = 0
 DecimalSeparator = Mid(Format(1.1, "General Number"), 2, 1)
 NonDecimalSeparator = IIf(DecimalSeparator = ".", ",", ".")
 
 On Error Resume Next
 For Each cell In Selection
  Stroka = Replace(cell, NonDecimalSeparator, DecimalSeparator, , , vbTextCompare)
  If IsNumeric(Stroka) Then
   If StrComp(Mid(cell.Address, 2, 1), "B") >= 0 Then
    Sum = Sum + CDbl(Stroka)
   End If
   cell.Formula = Stroka
  End If
 Next cell
 Application.OnUndo "Undo the Action macro", "UndoAction"
 MsgBox Sum
 If MsgBox("Вернуть изменения как росло?", vbYesNo, "Отмена изменений") = vbYes Then
  UndoAction
 End If
End Sub

Sub UndoAction()
    On Error GoTo Problem
    Application.ScreenUpdating = False
    OldWorkbook.Activate
    OldSheet.Activate
    For i = 1 To UBound(OldSelection)
        Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
    Next i
    Exit Sub
'   Error handler
Problem:
    MsgBox "Не получается вернуть изменения..."
End Sub

Основная функция - DoAction (её можно вызывать по нажатию кнопки, к примеру). Только сумму я вычисляю со столбца "В" для удобства, можешь заменить на собственный... Собственно, книгу с исходным кодом прикрепляю... Комментировать особенно нечего, код вроде не сложный...

Присоединённый файл ( Кол-во скачиваний: 3 )

Book1.rar 14,03 Kb

--------------------

самурай без меча подобен самураю с мечом, но только без меча

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »