Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.78/9: Рейтинг темы: голосов - 9, средняя оценка - 4.78
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
1

Поиск последнего столбца и копирование

19.06.2016, 12:01. Показов 1786. Ответов 12
Метки vba (Все метки)

Всем добрый день. Ребята подскажите пожалуйста, как найти столбец с именем "Столбец 25", в столбце найти строки с значением "Номер один" и все это , вместе со строками и шапкой скопировать на новый лист.
Вложения
Тип файла: rar _123 (1).rar (15.1 Кб, 2 просмотров)
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
19.06.2016, 12:01
Ответы с готовыми решениями:

Сравнение (поиск) ячеек из столбца и копирование к ним дополнительных данных
Добрый день! У меня к сожалению пока посредственные знания VBA, но я уже примерно попытался...

Поиск и копирование файлов по дате последнего изменения с раскладкой по папкам
Возникла такая казалось бы простая задача (по крайней мере в Windows, команда xcopy решает её...

SQL: поиск последней строки, последнего столбца
Добрый день. Подскажите, есть в SQL команды по поиску последней строки, столбца, в которых есть...

После последнего столбца матрицы, содержащего только отрицательные элементы, вставить 3 столбца из 99
Здравствуйте. Помогите, пожалуйста, решить задачу. Дана матрица размера M х N. После последнего...

12
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 14:45 2
Добавил свою кнопку, назначил этот макрос

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Копировать_Столбец25()
    Dim r As Range, maxRow&
    Set r = Cells.Find(What:="Столбец25", After:=Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If r Is Nothing Then
        MsgBox "Столбец25 не найден"
    Else
        maxRow = Cells(Rows.Count, r.Column).End(xlUp).Row
        Range(Cells(1, r.Column), Cells(maxRow, r.Column)).Copy
        With Worksheets.Add
            '-- Копировать будем в ячейку A1 на добаленном листе
            [a1].ColumnWidth = r.ColumnWidth
            [a1].Select
            .Paste
        End With
    End If
End Sub
Результаты на картинке:
Миниатюры
Поиск последнего столбца и копирование   Поиск последнего столбца и копирование  
Вложения
Тип файла: xls _123 (1).xls (48.5 Кб, 3 просмотров)
0
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
19.06.2016, 15:20  [ТС] 3
Спасибо большое, немного не так. нужно скопировать не один столбец. Нужно:
- шапку, все строки, у которых в столбце 25 содержится номер один
0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 15:26 4
Тоесть к примеру эту строку копировать надо ?
иванов номер один 02.05.2015 иванов номер один 02.05.2015
0
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
19.06.2016, 16:12  [ТС] 5
так точно
0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 16:16 6
Сможешь скинуть скрин, как это будет выглядеть на другом листе
тоесть на пустом листе всё то что должно туда попасть ?
0
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
19.06.2016, 16:19  [ТС] 7
вот так
Миниатюры
Поиск последнего столбца и копирование   Поиск последнего столбца и копирование   Поиск последнего столбца и копирование  

0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 16:26 8
А.. ну всё дошло, так это еще проще, погоди немного ушел решать ...
0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 17:18 9
Готово

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
Private Sub disAccelerateExcel() 'Включаем всё то что выключили процедурой AccelerateExcel
    On Error Resume Next
    With Application
        .ScreenUpdating = True 'Включаем обновление экрана после каждого события
        .Calculation = xlCalculationAutomatic 'Расчёты формул - снова в автоматическом режиме
        .EnableEvents = True 'Включаем события
        If Workbooks.Count Then _
            ActiveWorkbook.ActiveSheet.DisplayPageBreaks = True 'Показываем границы ячеек
        .DisplayStatusBar = True 'Возвращаем статусную строку
        .DisplayAlerts = True 'Разрешаем сообшения Excel
    End With
End Sub
 
 Private Sub AccelerateExcel() 'Ускоряем Excel путём отключения всего "тормозящего"
    On Error Resume Next
    With Application
        .ScreenUpdating = False 'Больше не обновляем страницы после каждого действия
        .Calculation = xlCalculationManual 'Расчёты переводим в ручной режим
        .EnableEvents = False 'Отключаем события
        If Workbooks.Count Then _
            ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False 'Не отображаем границы ячеек
        .DisplayStatusBar = False 'Отключаем статусную строку
        .DisplayAlerts = False 'Отключаем сообщения Excel
    End With
 End Sub
 
Sub Найти_number_one()
    Dim r As Range, i&, j&, maxRow&, maxColumn&
    Dim n&
    '
    AccelerateExcel 'Ускоряем работу Excel !
    '
    maxColumn = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
    maxRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    Set r = Range(Cells(1, 1), Cells(maxRow, maxColumn))
    With Worksheets.Add
        For i = 1 To maxRow: For j = 1 To maxColumn
            If r.Cells(i, j) = "номер один" Or i = 1 Then
                n = n + 1
                r.Range(r.Cells(i, 1), r.Cells(i, maxColumn)).Copy
                .Cells(n, 1).Select
                ActiveSheet.Paste
                Exit For
            End If
        Next: Next
        For i = 1 To maxRow
            .Cells(i, 1).RowHeight = r.Cells(i, 1).RowHeight
        Next
        For j = 1 To maxColumn
            .Cells(1, j).ColumnWidth = r.Cells(1, j).ColumnWidth
        Next
    End With
    '
    disAccelerateExcel 'Восстанавливаем Excel !
    '
End Sub
Вложения
Тип файла: xls _123 (1).xls (51.5 Кб, 4 просмотров)
0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 17:25 10
На выходе тоже самое



только без моей *красивой* кнопки )

Добавлено через 1 минуту
Строчки кода 48 - 54, это выравнивание ячеек, чтобы размер таблицы был одинаковый
можно конечно было форматом воспользоваться ....
0
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
19.06.2016, 18:00  [ТС] 11
Спасибо тебе большое. научи плохому, кодить?

Добавлено через 2 минуты
последний вопрос, а столбец 25 он ищет. или просто, если в строчке есть номер один, то ее и копирует?
0
oh my god
1448 / 787 / 161
Регистрация: 05.01.2016
Сообщений: 2,307
Записей в блоге: 8
19.06.2016, 18:17 12
Исходя из картинки что ты мне дал я решил этот вопрос так:
вот два цикла
For i = 1 To maxRow: For j = 1 To maxColumn
цикл i проходит по строчкам, цикл j проходит по каждой ячейке до последней занятой колонки
и как только возникает надпись № 1 выходит из просмотра j (каждой ячейки) затем копирует строчку целиком и переходит в следующую строчку ниже.. надеюсь объяснил доходчиво

Добавлено через 4 минуты
Да и вот еще что, процедуры AccelerateExcel и disAccelerateExcel можешь затереть
это чисто моя отсебятина (бонус) для того чтобы небыло реакций и обновлений тормозящих выполнение
обычно я этим пользуюсь при подобных манипуляциях с листами и копированиями
0
-28 / 6 / 1
Регистрация: 13.12.2015
Сообщений: 397
19.06.2016, 18:41  [ТС] 13
спасибо большое

Добавлено через 20 секунд
посоветуйте литературу пожайлуста
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
19.06.2016, 18:41

Вычесть из элементов первого столбца матрицы элементы последнего столбца, предварительно умноженных на 2
на C дана матрица размерности N на M. Вычесть из элементов первого столбца элементы последнего...

Найти все элементы пятого столбца двумерного массива, начиная с последнего элемента этого столбца
Доброго времени суток. Решите пожалуйста на языке С(и) а не С++. Есть примерная на языке с++,надо...

Excel. Копирование столбца, при заполнении 22-й строки продолжить копирование в соседний столбец
Всем привет. Задача: Есть таблица Excel, заполнены 2 столбца, из них первый - порядковые номера,...

Копирование столбца из DataGridView. Копирование ячейки из ДатаГридВью
Доброго времени суток! Что то читал читал форумы и гугл - а так и не нашел для себя решения. Смотрю...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru