Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.80/5: Рейтинг темы: голосов - 5, средняя оценка - 4.80
oksya
1 / 1 / 0
Регистрация: 21.10.2012
Сообщений: 57
1

Массив в Excel

09.10.2019, 16:40. Просмотров 854. Ответов 7
Метки нет (Все метки)

Вечер добрый. Уважаемые форумчане, научите, пожалуйста, как сделать, чтобы "пробежаться" по строкам до строки "Итого"
Есть таблица, с любым кол-вом строк.
При выгрузке из внешней программы, объединены столбцы B,C,D,E с названием имущества.
Данные всегда начинаются в ячейке B8 и заканчиваются строкой "Итого"

Нужно по всем строкам с данными:
1. снять объединение с ячеек B,C,D,E
2. удалить образовавшиеся пустые столбцы C,D,E
3. выделив только данные со строками, сделать автовысоту строки.

Макросом у меня получилось снять объединение с первой строки с данными, форматом по образцу ("кисточкой") снять с остальных строк, удалить пустые столбцы, сделать автовысоту
Помогите "пробежать" по строкам, сейчас я задаю диапазон ячеек вручную, но строк может быть сколько угодно, в данной таблице около 600 ((
Заранее спасибо

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub ()
    Range("B8").Select
     
     With Selection                                  'отмена объединения столбцов
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("B8").Select
    Selection.Copy
    
    Range("B9:E14").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False   'разбивка на столбцы по образцу
    Application.CutCopyMode = False
    Columns("B:B").ColumnWidth = 27.57   'установка ширины столбца
    
    Columns(3).Delete Shift:=xlToLeft    ' удаление cтолбцов C,D,E
    Columns(3).Delete Shift:=xlToLeft
    Columns(3).Delete Shift:=xlToLeft
    
    Range("B8:B14").Select
    Selection.Rows.AutoFit     'автовысота строк
End Sub
0
Вложения
Тип файла: xlsx Налог исходник — копия.xlsx (11.9 Кб, 3 просмотров)
Лучшие ответы (1)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.10.2019, 16:40
Ответы с готовыми решениями:

Excel: чтение в массив полей таблицы Excel?
Добрый день, появилась необходимость написать некий макрос, с VBA столкнулся впервые. Нагуглить...

Outlook, массив в Excel
Здравствуйте! Мне нужно написать макрос в Outlookе, который обрабатывает данные в Excel. Проблема в...

Копирование из word в массив excel
Всем привет! Подскажите, плиз, кто знает, как в word-е найти и скопировать в массив excel текст,...

VBA Excel двумерный массив
Помогите, нужна помощь Есть двумерный массив размером X mхn елементов (m - строк, n - столбцов)...

Массив данных из таблицы Excel
В общем, этот код должен вычислять сумму индексов отрицательных элементов матрицы над побочной...

7
ArtNord
202 / 147 / 60
Регистрация: 18.11.2015
Сообщений: 690
09.10.2019, 16:50 2
Лучший ответ Сообщение было отмечено oksya как решение

Решение

Visual Basic
1
2
3
4
5
6
Sub ОбработкаВыгрузки()
eRow = Cells.SpecialCells(xlLastCell).Row
    Columns("C:E").Delete Shift:=xlToLeft
    Range("B7:B" & eRow).ShrinkToFit = False
Rows("8:" & eRow).EntireRow.AutoFit
End Sub
1
art1289
41 / 33 / 8
Регистрация: 02.08.2019
Сообщений: 137
Записей в блоге: 3
09.10.2019, 16:56 3
oksya, привет

вот этот код определяет последнюю строку в столбце, тут по столбцу A (1)

Visual Basic
1
lastRow=ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
тогда ваш код

Visual Basic
1
 Range("B8:B" & lastRow).Select
https://vk.com/vbatools
1
ArtNord
202 / 147 / 60
Регистрация: 18.11.2015
Сообщений: 690
09.10.2019, 16:59 4
Если принципиально "Итого", а не просто последняя строка, то:
Visual Basic
1
2
3
4
5
6
7
8
9
Sub ОбработкаВыгрузки()
'eRow = Cells.SpecialCells(xlLastCell).Row
Dim fRow As Range
Set fRow = Columns("A:B").Find(What:="Итого", LookAt:=xlWhole)
eRow = fRow.Row
    Columns("C:E").Delete Shift:=xlToLeft
    Range("B7:B" & eRow).ShrinkToFit = False
Rows("8:" & eRow).EntireRow.AutoFit
End Sub
1
09.10.2019, 16:59
art1289
41 / 33 / 8
Регистрация: 02.08.2019
Сообщений: 137
Записей в блоге: 3
09.10.2019, 17:01 5
oksya, универсальная функция нахождения последнего по номеру и букве

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Function LastRowOrColumn(ByVal NomerRowOrColumn As Variant, _
                        Optional WorkSheetName As Variant = vbNullString, _
                        Optional RowOrColumn As Boolean = True) As Integer
                        
'NomerRowOrColumn - номер или буква искомого столбца для строк, строки для столбцов, обезательный параметр
'WorkSheetName - на каком листе искать, по умолчанию используется активный, не обезательный параметр
'RowOrColumn - поиск строки или столбца, по умолчанию по ищем строку, не обезательный параметр
 
On Error GoTo Err_msg_WSN
Dim WH As Worksheet
    If WorkSheetName = vbNullString Then
        Set WH = ThisWorkbook.ActiveSheet
    ElseIf IsNumeric(WorkSheetName) Then
        Set WH = ThisWorkbook.Worksheets(CInt(WorkSheetName))
    Else
        Set WH = ThisWorkbook.Worksheets(WorkSheetName)
    End If
 
    If RowOrColumn Then
        If Not IsNumeric(NomerRowOrColumn) Then
            LastRowOrColumn = WH.Cells(Rows.Count, NomerRowOrColumn).End(xlUp).Row
        Else
            LastRowOrColumn = WH.Cells(Rows.Count, CInt(NomerRowOrColumn)).End(xlUp).Row
        End If
    Else
        If Not IsNumeric(NomerRowOrColumn) Then
            LastRowOrColumn = WH.Cells(NomerRowOrColumn, Columns.Count).End(xlToLeft).Column
        Else
            LastRowOrColumn = WH.Cells(CInt(NomerRowOrColumn), Columns.Count).End(xlToLeft).Column
        End If
    End If
    
Exit Function
 
Err_msg_WSN:
    Select Case Err.Number
        Case 13, 1004:
           Call MsgBox("Веденно не допустимое значение номере столбца или строки: [" & NomerRowOrColumn & "] ", vbCritical, "Ошибка ввода:")
        Case 9:
             Call MsgBox("Веденно не допустимое значение в имени файла: [" & WorkSheetName & "] ", vbCritical, "Ошибка ввода:")
        Case Else:
            Call MsgBox("Ошибка:" & vbLf & Err.Number & vbLf & Err.Description, vbCritical, "Ошибка:")
    End Select
End Function
https://vk.com/vbatools
1
oksya
1 / 1 / 0
Регистрация: 21.10.2012
Сообщений: 57
09.10.2019, 17:05  [ТС] 6
ArtNord, Спасибо огромнейшее!
За оперативность - отдельное )))

Добавлено через 1 минуту
Нет, "Итого" не принципиально, просто подумалось, что можно привязаться к ней

Добавлено через 26 секунд
Всем большое спасибо за помощь и разъяснения )

Добавлено через 53 секунды
art1289, благодарю Вас за подробное объяснение
0
SoftIce
es geht mir gut
11121 / 4532 / 1144
Регистрация: 27.07.2011
Сообщений: 11,132
Завершенные тесты: 1
09.10.2019, 17:27 7
art1289, с учётом подвала, эта функция не подойдёт.
0
art1289
41 / 33 / 8
Регистрация: 02.08.2019
Сообщений: 137
Записей в блоге: 3
09.10.2019, 17:54 8
SoftIce, добрый вечер, это пример, все я думаю не глупые тут и могут адаптировать код
0
09.10.2019, 17:54
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.10.2019, 17:54

Массивы в Excel. Задан массив Z (12)
Задан массив Z(12). Просуммировать числа, находящиеся на чётных позициях в массиве, если они не...

В массив занести данные из ячеек Excel
Подскажите пожалуйста как в массив vba положить данные из ячеек excel, для дальнейших с ними...

Двумерный массив вывести на лист Excel
Написать макрос, который просит пользователя ввести количество учащихся. Затем предлагает ввести...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.