Выручите по Exel, сводная таблица буксует

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Здравствуйте! Если кто может помочь, то тема такая: есть данные в 2-х столбцах, в одном столбце наименования, в другом числа. Напротив каждого наименования по строке вносится число, а где не вносится предполагаем "0". Необходимо свести в таблицу на др. листе в таком же порядке "наименование и число", но только те строки в которых число >0. Может можно обойтись функцией, то какой скрипт? Если нет то помогите с кодом VBA. Буду премного благодарен.
Аватара пользователя
AlexZZZ
Сообщения: 237
Зарегистрирован: 01 июн 2007, 00:27
Откуда: Москва и область

На Ваш вопрос сложно ответить, т.к. не до конца понятна задача. Что, нужно исключить строки с пустыми значениями числового поля? И чем именно буксует сводная таблица? Тем что суммирует значения? Или тем, что приводит список наименований не в том порядке в котором они находятся в исходной таблице? А ещё лучше, если бы Вы прикрепили файлик с примером Вашей таблицы и тем результатом, который хотели бы получить. Тогда больше вероятность, что Вам помогут.
Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Я действительно недостаточно раскрыл вопрос получения результата, а сводной таблицей я пробовал решить эту задачу, но у меня неполучилось ее создать именно с таким результатом.Спасибо AlexZZZу за отзыв и совет, я непременно прилагаю пример и надеюсь на помощь.
Вложения
Перенос данных.jpg
Перенос данных.jpg (15.96 КБ) 429 просмотров
Аватара пользователя
AlexZZZ
Сообщения: 237
Зарегистрирован: 01 июн 2007, 00:27
Откуда: Москва и область

Насколько я понимаю, в Вашем случае не нужны ни сводная таблица, ни VBA. Достаточно простого автофильтра, чтобы поставить на него условие "больше 0", скопировав затем полученную выборку на нужный лист.
Но если нужно непременно макросом, то можно так:

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

Sub MyMacros()
    Dim n As Long
    Dim i As Long
    Worksheets("Лист2").Range("A1:B1").Value = Worksheets("Лист1").Range("A1:B1").Value
    i = 2
    For n = 2 To Worksheets("Лист1").Range("A1").CurrentRegion.Rows.Count - 1
        If Worksheets("Лист1").Range("B" & n).Value > 0 Then
            Worksheets("Лист2").Range("A" & i & ":B" & i).Value = _
            Worksheets  ("Лист1").Range("A" & n & ":B" & n).Value
           i = i + 1
        End If
    Next n
End Sub
Предполагается, что исходные данные хранятся на "Лист1", а переносятся на "Лист2", сама таблица состоит из двух столбцов, причём числовые данные хранятся в столбце "B", а первая ячёйка титульной строки начинется с "A1". Иначе - код отредактировать несложно.
Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Очень итересен вариант автофильтра, я обязательно попробую применить, но код макроса просто необходим на случай добавления еще одного столбца или изменения сценария в столбце "Названия".Например будет ли переносится название сцепленное с числовым значением которое указывает на определенные параметры (размер).
Как бы там нибыло появилась возможность продолжить задуманное большое спасибо начну применять код и по результату отвечу.
Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Здравствуй AlexZZZ!Сообщаю тебе что код работает хорошо и результат получен,но подскажи как подредактировать его чтобы перенос осуществлялся автоматически при заполнении числового значения и при измененении его на другое без дополнительных действий если возможно (извини за малограмотность).А с автофильтром что то не получилось, пробовал расширенный фильтр, но и там даже перенос только на тотже лист.
Аватара пользователя
AlexZZZ
Сообщения: 237
Зарегистрирован: 01 июн 2007, 00:27
Откуда: Москва и область

Нужно поместить в модуль листа1 код, отслеживающий изменение ячеек в столбце 2("B"):

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

Private Sub Worksheet_Change(ByVal Target As Range)
	If Target.Column = 2 Then
		
		'...код переноса на лист 2

	End If
End Sub
Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Здравствуй AlexZZZ. Попытался подставить ('...код переноса на лист 2) как ты написал, опробывал разные варианты,но увы чегото не работает, вероятно что то сделал не так.
Не обьяснишь для непонятливых подробнее? А лучше если пропишешь полностью это было бы супер. Заранее благодарю.
Аватара пользователя
AlexZZZ
Сообщения: 237
Зарегистрирован: 01 июн 2007, 00:27
Откуда: Москва и область

Я имел в виду это:

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

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 2 Then
        Dim n As Long
        Dim i As Long
        Worksheets("Лист2").Range("A1:B1").Value = Worksheets("Лист1").Range("A1:B1").Value
        i = 2
        For n = 2 To Worksheets("Лист1").Range("A1").CurrentRegion.Rows.Count - 1
            If Worksheets("Лист1").Range("B" & n).Value > 0 Then
                Worksheets("Лист2").Range("A" & i & ":B" & i).Value = _
                Worksheets("Лист1").Range("A" & n & ":B" & n).Value
               i = i + 1
            End If
        Next n
    End If
End Sub
:)
Новичек
Сообщения: 8
Зарегистрирован: 19 май 2009, 15:19

Приветствую AlexZZZ. В принципе я подставлял так же, но теперь понял свою ошибку. У меня в конце получалось 2 раза (End If End Sub) и редактор ругался. А теперь все работает очень хорошо, но еще один момент: при наборе в Лист1; столбец В числовых значений они благополучно с текстом из Лист1: столбец А переносятся автоматом в Лист2 в порядке набора в Листе1, затем когда я меняю числовые значения на другие происходит замена и в Лист2, но когда я убираю какое-нибудь число вообще, изменение в Лист2 не происходит, приходится стирать вручную А и В в Лист2. Если бы возможно сделать такое автостирание (только ячеек с текстом и нулевым значением) не теряя перенос уже введенных данных, то получился бы идеальный результат.
Ответить