Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Создание таблицы из нескольких таблиц по условию

Создание таблицы из нескольких таблиц по условию

Ответ
Поиск в этой теме
Непрочитано 23.04.2007, 14:23 #1
Создание таблицы из нескольких таблиц по условию
Sergey57
 
РОССИЯ
Регистрация: 23.04.2007
Сообщений: 2

Если кто может, подскажите пожалуйста, как сделать так, чтобы информация из двух таблиц в Икселе вставлялась в третью таблицу при выполнении в первых двух таблицах определенного условия.
А именно.
таблицы (упрощенно) такого вида:

гипс - белый гипс - белый
гипс - черный гипс - зеленый
кирпич - желтый кирпич - красный
кирпич - белый гипс - черный
кирпич - желтый гипс - белый

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

то есть у меня должна получиться таблица
кирпич - желтый
кирпич - белый
кирпич - желтый
кирпич - красный
здесь вставились три строки из первой таблицы и одна из второй

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

Сразу скажу, что функции типа Консолидация, Фильтрация и подобные им в Икселе, а также все формулы такого сделать не позволяют.

поэтому я и обращаюсь к Вам.
Спасибо"!
Просмотров: 6055
 
Непрочитано 25.04.2007, 14:35
#2
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Исходные таблицы в 4 столбца?

~'J'~
fixo вне форума  
 
Непрочитано 25.04.2007, 15:35
#3
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Вот примерный ход
Одна таблица на 1 листе, другая на втором
Общая таблица создается на третьем
Чтобы создать рекцию на изменение одной
или обеих таблиц нужно точно знать количество
столбцов в них
Код:
[Выделить все]
Option Explicit

Public Sub ConsolidateByVal(ByVal goal As String)
Dim sht As Worksheet
Dim cel As Range, ncel As Range
Dim i As Long
i = 1
Dim dsht As Worksheet
Set dsht = ThisWorkbook.Worksheets(3)
With dsht.UsedRange
.ClearContents
End With
Set sht = ThisWorkbook.Worksheets(1)
sht.Activate

For Each cel In sht.UsedRange.Cells
Debug.Print cel.Value
If cel.Value = goal Then
Set ncel = cel.Offset(, 1)
dsht.Cells(i, 1) = cel.Value
dsht.Cells(i, 2) = ncel.Value
i = i + 1
End If
Next
Set sht = ThisWorkbook.Worksheets(2)
sht.Activate

For Each cel In sht.UsedRange.Cells
Debug.Print cel.Value
If cel.Value = goal Then
Set ncel = cel.Offset(, 1)
dsht.Cells(i, 1) = cel.Value
dsht.Cells(i, 2) = ncel.Value
i = i + 1
End If
Next
DoEvents
dsht.Activate
dsht.UsedRange.Select

End Sub

Sub test()
Dim a As String
a = "кирпич"
ConsolidateByVal (a)
End Sub
fixo вне форума  
 
Непрочитано 25.04.2007, 16:42
#4
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Или еще проще
Помести этот код в модуле ThisWorkBook

Код:
[Выделить все]
Option Explicit


Private Sub ConsolidateByVal(ByVal goal As String)
     Dim sht As Worksheet
     Dim cel As Range, ncel As Range
     Dim i As Long
     i = 1
     Dim dsht As Worksheet
     Set dsht = ThisWorkbook.Worksheets(3)
     With dsht.UsedRange
          .ClearContents
     End With
     Set sht = ThisWorkbook.Worksheets(1)
     sht.Activate

     For Each cel In sht.UsedRange.Cells
          Debug.Print cel.Value
          If cel.Value = goal Then
               Set ncel = cel.Offset(, 1)
               dsht.Cells(i, 1) = cel.Value
               dsht.Cells(i, 2) = ncel.Value
               i = i + 1
          End If
     Next
     Set sht = ThisWorkbook.Worksheets(2)
     sht.Activate

     For Each cel In sht.UsedRange.Cells
          Debug.Print cel.Value
          If cel.Value = goal Then
               Set ncel = cel.Offset(, 1)
               dsht.Cells(i, 1) = cel.Value
               dsht.Cells(i, 2) = ncel.Value
               i = i + 1
          End If
     Next
     DoEvents
     dsht.Activate
     dsht.UsedRange.Select

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Dim a As String
     a = "кирпич"
     ConsolidateByVal (a)
End Sub
Тогда при сохранении файла всякий раз будет инициироваться
пересчет таблицы

~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 26.04.2007, 11:34
#5
Sergey57


 
Регистрация: 23.04.2007
РОССИЯ
Сообщений: 2


исходные таблицы в 2 столбца. просто у меня почему-то удалились пробелы между двумя таблицами, когда я отправил свое сообщение.
Спасибо огромное за варианты, буду проверять.
Sergey57 вне форума  
 
Непрочитано 26.04.2007, 11:51
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Проще всего было xls-файл запаковать и приложить
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 26.04.2007, 12:30
#7
shnn

Инженер
 
Регистрация: 18.02.2005
Самара
Сообщений: 747


>Sergey57
Я не силен в программировании, но если я правильно понял задачу, то можно задать это все логическими функиями. Если выполняется условие табл.1 то в табл.1а записывается 1, в противном случае 0. Если выполняется условие табл.2 то в табл.2а записывается 1, в противном случае 0. Далее просуммировать данные 1а и 2а. Если равно 2, то выполнились условия в обеих таблицах. Если коряво объяснил сори, пишите в личку скину файл.
shnn вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Создание таблицы из нескольких таблиц по условию

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск