|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
20.08.2013, 15:24 | #1 |
Регистрация: 19.08.2013
Сообщений: 8
|
Вкладочный вид базы Excel
Доброго времени суток, основная задача состоит в корректировке большой базы с данными для более удобного использования пользователям.
вот логический код программы: Вводим переменную Заполняем данными из выделенной ячейки если они отличаются от данных в переменной смещаем строку, переносим(вырезаем) спускаться в низ Если данные ячейки одинаковы с содержанием переменной - удалить спускаться в низ Иначе содержание ячейки отличаются от содержания переменной заполнить переменную данными из ячейки смещаем строку , переносим(вырезаем) спускаемся в низ Если клетка пустая Спускаемся в низ ----- вот код программы: Sub old() ' ' old Макрос ' ' Сочетание клавиш: Ctrl+ц ' Dim a As Integer ' Вводим переменную a = Selection With Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Вставка(смещение) ActiveCell.Offset(1, 0).Select Selection.Cut ActiveCell.Offset(-1, 0).Select ActiveSheet.Paste End With With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False 'шрифт за границы и приравнивание налево .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveCell.Offset(1, 0).Select 'Спускаемся сравниваем значение с а If Selection = a Then Selection.ClearContents 'Удаляем если равно If Selection <> a Then a = Selection 'если не равно забираем значение из новой клетки Rows("2:2").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ActiveCell.Offset(1, 0).Select Selection.Cut ActiveCell.Offset(-1, 0).Select ActiveSheet.Paste With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection 'шрифт, смещение .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End If IsEmpty(ActiveCell.Value) = True Then ActiveCell.Offset(1, 0).Select End If End If End If End Sub Существует 2 проблемы: 1) Цикличность. не знаю как заставить её выполнять повторения впредь до тысяч так 5 2) ошибка в коде из-за которой действующая ячейка не смещается а постоянно находится на а2, при этом сдвигая все вверх(должна реагировать на выделенную ячейку(и действовать от неё(выделенную мышкой)) Объясните пожалуйста как использовать "Rows" и как заставить двигаться от выделенной ячейки вниз |
20.08.2013, 15:28 | #2 |
Старожил
Регистрация: 11.05.2010
Сообщений: 5,166
|
Я думаю что всё нужно делать иначе.
Но конечно если увижу файл и пойму задачу - может быть передумаю
webmoney: E265281470651 Z422237915069 R418926282008
|
20.08.2013, 15:37 | #3 |
Регистрация: 19.08.2013
Сообщений: 8
|
Вот вся задача
|
20.08.2013, 16:18 | #4 |
Новичок
СтарожилДжуниор
Регистрация: 05.02.2008
Сообщений: 9,487
|
полагаю этот
Код:
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
|
20.08.2013, 16:37 | #5 | |
Регистрация: 19.08.2013
Сообщений: 8
|
Цитата:
нужно что бы вставлялась строка а данные из клетки перемещались на 1 клетку вверх что бы быть "оглавлением" (повторяющиеся снизу удаляются, другие аспекты так же становятся оглавлениями) Последний раз редактировалось Heavyhand; 20.08.2013 в 16:53. |
|
20.08.2013, 17:14 | #6 |
Новичок
СтарожилДжуниор
Регистрация: 05.02.2008
Сообщений: 9,487
|
однако...
Ваш код я даже не пытался анализировать. по первой картинке стало понятно, что надо сделать а вот по второй... четкие очертания задачи совершенно размылись и не просматриваются
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
|
21.08.2013, 11:11 | #7 |
Регистрация: 19.08.2013
Сообщений: 8
|
вот так должна работать программа для всех столбцов
(в коде написано для одного столбца)
|
27.08.2013, 09:33 | #8 |
Регистрация: 19.08.2013
Сообщений: 8
|
Рабочий код
Public a As String
Public x1 As Integer Public y1 As Integer Public i As Integer Public x2 As String Public y2 As Integer Sub old() ' ' old ' ' : Ctrl+й ' x1 = Selection.Cells.Column y1 = Selection.Cells.Row x2 = ActiveCell.SpecialCells(xlLastCell) .Column y2 = ActiveCell.SpecialCells(xlLastCell) .Row i = y1 While i < y2 + 1 If IsEmpty(ActiveCell.Value) = True Then ActiveCell.Offset(1, 0).Select i = i + 1 Else If Selection <> a Then a = Selection With ActiveCell.Rows("1:1").EntireRow.Se lect Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Cells(i, x1).Select ActiveCell.Offset(1, 0).Select Selection.Cut ActiveCell.Offset(-1, 0).Select ActiveSheet.Paste End With With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ActiveCell.Offset(1, 0).Select i = i + 1 y2 = y2 + 1 Else Selection.ClearContents ActiveCell.Offset(1, 0).Select i = i + 1 End If End If Wend i = 0 End Sub |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
оболочка базы данных для excel | seven123 | Microsoft Office Excel | 0 | 29.02.2012 08:43 |
добавление базы из excel в access | Enkoff | Microsoft Office Access | 1 | 22.12.2011 13:32 |
в диаграмме excel можно было вбивать данные и изменять ее вид | Mr_skiner | Общие вопросы Delphi | 1 | 08.06.2010 20:30 |
Базы данных в Excel+VBA | Анна Рожкова | Помощь студентам | 3 | 04.04.2010 19:06 |
создание договора в ворде на основе базы в Excel | mistx | Microsoft Office Excel | 19 | 17.10.2009 23:41 |