Кнопка в Excel

[sergpan]

Как при нажатии кнопки на одном листе цифры разных ячеек перемещались с нарастающим на точно такие же ячейки другого листа с уже имеющимися цифрами?

[DDimok]

Ээээ ... Вроде не так много вчера выпил, но ничего не понял

[GSerg]

Код: Выделить всё

sub foo (byval rFrom as range, byval rTo as range)
  dim i as long
 
  if rfrom.cells.count<>rto.cells.count then err.raise 5,,"Нефиг!"
 
  for i=1 to rfrom.cells.count
    rto.cells(i).value=rto.cells(i).value+rfrom.cells(i).value
  next
end sub

[Deja-vu]

sergpan ты имешь ввиду, что просто на первом листе у тебя цифры, на втором тоже цифры... надо на второй лист на место цифр скопировать цифры первого в возрастающем порядке с тем, чтобы цифры второго были стерты или остались также? ))))))

[sergpan]

Есть 13-ть листов, 12-ть из них это месяцы (названия листов: январь, февраль,март,... и т.д.), а 13-тый лист сводный с кнопкой, полем со списком месяцев и точно такой же таблицей как на предыдущих листах. Суть в том чтобы при выборе месяца в поле и заполнении ячеек цифрами при нажатии кнопки эти цифры перемещались в выбранный месяц с нарастанием. Ячейки, в которых содержатся цифры на всех листах одинаковые.

[Deja-vu]

Теперь понял... Ты цифры как размещаешь? Строчками? В смысле, сверху вниз?
Тогда тебе без разницы, как скопировать, по возрастанию, или нет... ты копируй все цифры, что есть путем вот этого:

sub copyone()
Worksheets("Sheet1").Range("A1").copy.Worksheets("Sheet2").Range("A1")
end sub

Цикл на 32 строки сумеешь сам составить? Подставляешь есс-но названия листов вместо Sheet1 и Sheet2 по месяцам
и адрес ячейки вместо A1 ....
Ну а в самый конец кода ставишь сортировку по возрастанию...

Worksheets("Sheet1").Range("A1").AutoFilter
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Надеюсь, я твою проблему понял правильно...

[Deja-vu]

pashulka

так как под нарастанием имелось ввиду сложение уже имеющегося числа с новым

Значит я не совсем точно понял условие задачи...

[Deja-vu]

Ждем автора вопроса.

[sergpan]

Извините за поздний ответ. Ниче не получается. Пишет ошибку в строке
Worksheets(1).Range("A1").Copy Worksheets(2).Range("A1")
Worksheets(1).Range("A1").Copy Destination:=Worksheets(2).Range("A1")

[sergpan]

Листов хватает и не заблокирован!
Повторю задачу: имеетсе 13 листов с одинаковыми таблицами. 12 листов-это месяцы "январь, февраль,март,.....,декабрь", а 13-тый со сводной таблицей, с полем со списком месяцев и кнопкой "Ввод данных". Проблема в том, чтобы при выборе месяца в поле со списком и заполнении ячеек, при нажатии кнопки цифры перемещаются в выбранный месяц в точно такие же ячейки с НАРАСТАНИЕМ(СУММИРУЮТСЯ)

[vrodo]

кинь файл плиз
Nrobuk@luxoft.com
интересно взглянуть

[vrodo]

Привет всем!

Так автор темы и пропал, может интернет отрубили
Хотя мне файл прислал и сам пропал
Если кому интересно то я ему предложил два варианта кода

Это для листа с отчетностью можно использовать

Код: Выделить всё

Sub zzz()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range

Dim check As Boolean

Dim FunctionString As String
Dim s
Dim z

Set wb = Application.ThisWorkbook
Set wsto = wb.Worksheets("фин_операции")
Set rng = wsto.Range("L1")


s = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
check = False

If Len(rng) > 0 Then
For Each z In s
    If z = rng Then check = True
   
    If check Then
        FunctionString = FunctionString & ",'" & z & "'!G7"
    End If
Next
If Len(FunctionString) > 0 Then wsto.Range("G7").Formula = "=SUM(" & Right(FunctionString, Len(FunctionString) - 1) & ")"
End If
End Sub

А этот собственно, как мне кажется, решение его проблемы

Код: Выделить всё

Sub zzz2()
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range



Set wb = Application.ThisWorkbook
Set wsto = wb.Worksheets("фин_операции")
Set rng = wsto.Range("L1")



If Len(rng) > 0 Then
' ну если в ячейке чтонибудь есть то прибавляем
        wb.Worksheets(CStr(rng)).Range("G7") = wb.Worksheets(CStr(rng)).Range("G7") + wsto.Range("G7")
End If
MsgBox "Добавлено!"
End Sub

последний код было предложено серилизовать на необходимое количество клеток, которые можно выбирать из массива

хотя по моему мнению такие вещи лучше делать в Access так как не остается никакой истории
да и не приспособлен для этого Excel криво получается

[vrodo]

Дело в том что он мне прислал голый файл без макросов поэтому я немогу посмотреть где у него возникала ошибка
Решение Gserg-а было исчерпывающим, но видимо он не понял как этим пользоваться хотя оно выглядит более элегантно и универсально нежели мое
Фактически я написал то же самое, но прозой
А поэзию GSerg-а некоторые непоняли

[sergpan]

Огромное спасибо всем откликнувшимся на мою беду, но остался последний вопрос к vrodo как сделать чтобы перемещалась не одна ячейка G7, а допустим весь столбец G?

[vrodo]

ну чтоб было наглядней
посмотри первый пример и сделай массив ячеек
s = Array("G7","G8", "G9","G10","E7"............. и т.д.
всех которые ты хочешь изменить
так как шаблоны у тебя одинаковые то это будет работать для всех листов

в цикле
for each x in s
wb.Worksheets(CStr(rng)).Range(cstr(x)) = wb.Worksheets(CStr(rng)).Range(cstr(x)) + wsto.Range(cstr(x))

next x

извини пишу код прямо здесь и его не проверял, но думаю будет работать