Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Перенос данных из одной таблицы в другую - что не так в программе?
 
#1
18.11.2009 10:00:35
Всем добрый день!  
Помогите найти в чем ошибка.  
У меня есть два файла "Экономика" и "итого".  
Из столбца "Общая оценка" файла "Экономика" необходимо в соответствии с наименованием ценной бумаги передать данные в столбец Общая оценка" файла "итого".  
 
Sub join_files_data()  
Dim c As Object, b As Object  
Application.ScreenUpdating = False  
 
Workbooks("Экономика.xls").Activate  
With Workbooks("Экономика.xls").Sheets("параметры").Cells  
Set c = .Find("Наименование ценной бумаги", LookIn:=xlValues)  
If Not c Is Nothing Then  
firstAddress = c.Address  
Do  
 
Set b = Workbooks("итого.xls").Sheets(1).Cells.Find(c.Offset(1, 0).Value, LookIn:=xlValues)  
 
If Not b Is Nothing Then  
 
b.Offset(0, 30) = c.Offset(1, 13)  
 
Set c = .Find("Наименование ценной бумаги", after:=c, LookIn:=xlValues)  
Loop While Not c Is Nothing And c.Address <> firstAddress  
End If  
End With  
Application.ScreenUpdating = True  
End Sub  
 
 
Помогите, пожалуйста!
 
 
 
#2
18.11.2009 10:14:21
Посмотреть файл сйчас не могу. На первый взгляд должно работать, но две вещи я бы исправил:  
 
b.Offset(0, 30) = c.Offset(1, 13) заменил бы b.Offset(0, 30).Value = c.Offset(1, 13). Value    
 
и в конструкциях типа Workbooks("Экономика.xls").Sheets("параметры").Cells.Find заменил бы .Cells на  .UsedRange.  
До вечера...
 
 
 
#3
18.11.2009 11:25:35
В одном месте endif забыт и проверку цикла надо иначе организовать. Активате - лишний  
 
Sub join_files_data()  
Dim c As Range, b As Range, flag As Boolean  
Application.ScreenUpdating = False  
 
With Workbooks("Экономика.xls").Sheets("параметры").Cells  
 Set c = .Find("Наименование ценной бумаги", LookIn:=xlValues)  
 If Not c Is Nothing Then  
   firstAddress = c.Address  
   Do  
 
     Set b = Workbooks("итого.xls").Sheets(1).Cells.Find(c.Offset(1, 0).Value, LookIn:=xlValues)  
 
     If Not b Is Nothing Then  
 
       b.Offset(0, 30) = c.Offset(1, 13)  
     End If  
     Set c = .Find("Наименование ценной бумаги", after:=c, LookIn:=xlValues)  
     flag = False  
     If Not c Is Nothing Then If c.Address <> firstAddress Then flag = True  
   Loop While flag  
 End If  
End With  
Application.ScreenUpdating = True  
End Sub
Bite my shiny metal ass!      
 
 
 
#4
18.11.2009 12:19:11
Спасибо большое!  
Ошибку теперь не выдает, но и данные не переносятся!
 
 
 
#5
18.11.2009 12:25:57
Вот такой итог должен быть как во вложении.
 
 
 
#6
18.11.2009 15:32:11
1. В post_77647.xls в ячейке AV21 стоит "Низкая". Макрос тоже в ту же ячейку и лепит. А Вы, вероятно, хотите в ячейку АЕ21 получить "Низкая"?  
Тогда меняйте b.Offset(0, 30) на b.Offset(0, 13)  
И не используйте объединенные ячейки, если не хотите таких проблем.
Bite my shiny metal ass!      
 
 
 
#7
18.11.2009 16:15:58
при такой замене вообще ничего никуда не копируется. Что делать? Помогите, пожалуйста
 
 
 
#8
18.11.2009 16:24:23
{quote}{login=Natalia}{date=18.11.2009 04:15}{thema=}{post}Что делать? {/post}{/quote}Прямо по Чернышевскому...  
Еще раз, здесь, словами опишите: что откуда куда    
В файлах цветом выделяете нужные ячейки.
Bite my shiny metal ass!      
 
 
 
#9
18.11.2009 16:26:33
И еще добавка: в архив два файла (как в первом посте), только в одном из них есть код (макрос). А то Вы каждый раз выкладываете без макроса - не видно что в реальности происходит.
Bite my shiny metal ass!      
 
 
 
#10
18.11.2009 16:45:50
У меня есть два файла "Экономика" и "итого".  
Из столбца "Общая оценка" (столбец N) таблицы файла "Экономика" необходимо в соответствии с наименованием ценной бумаги передать данные в столбец Общая оценка" (столбец AE) файла "итого".  
Результат отображен в файле "что должно получиться".  
В таблице файла "Экономика" наименований может быть больше ста.
 
 
 
#11
18.11.2009 16:50:53
При работе программы оба файла "Экономика" и "итого" должны быть открыты.
 
 
 
#12
18.11.2009 17:02:10
Да, всё работает, спасибо ВАМ!  
 
Единственное НО:  
Бумага: Газпром нефть, 43 - оценка "Низкая" - перенеслось верно  
Бумага: Газпром нефть, 4 - оценка "Низкая" - перенеслось неверно "Средняя"
 
 
 
#13
18.11.2009 17:19:57
Sub join_files_data()  
Dim c As Range, b As Range, flag As Boolean  
Application.ScreenUpdating = False  
 
With Workbooks("Экономика.xls").Sheets("параметры").Cells  
 Set c = .Find("Наименование ценной бумаги", LookIn:=xlValues)  
 If Not c Is Nothing Then  
   Do While c.Offset(1 + i, 0) <> ""  
 
     Set b = Workbooks("итого.xls").Sheets(1).Cells.Find(c.Offset(1 + i, 0).Value, after:=Workbooks("итого.xls").Sheets(1).Cells(1, 1), LookIn:=xlValues)  
 
     If Not b Is Nothing Then  
     firstAddress = b.Address  
       Do  
         b.Offset(0, 13) = c.Offset(1 + i, 13)  
         Set b = Workbooks("итого.xls").Sheets(1).Cells.Find(c.Offset(1 + i, 0).Value, after:=b, LookIn:=xlValues)  
         flag = False  
         If Not c Is Nothing Then If b.Address <> firstAddress Then flag = True  
       Loop While flag  
     End If  
     i = i + 1  
   Loop  
 End If  
End With  
Application.ScreenUpdating = True  
End Sub  
 
Смотрите.  
Экономика - "Бумага: Газпром нефть, 4 "  
итого - "Бумага: Газпром нефть, 4"  
разницу видно?  
Поэтому не переносит.
Bite my shiny metal ass!      
 
 
 
#14
18.11.2009 17:20:14
Нашла в чем причина:  
Заменила строчку rFngRng.Offset(0, 13) = rCell.Offset(1, 13)  
на rFngRng.Offset(0, 13) = rCell.Offset(0, 13)  
 
теперь всё верно работает!  
 
 
Скажите, а как быть, если названия совпадают только частично или есть пробелы, но общая часть есть, что сделать, чтобы всё равно перекидывались данные?
 
 
 
#15
18.11.2009 17:24:49
{quote}{login=Natalia}{date=18.11.2009 05:20}{thema=}{post}  
 
Скажите, а как быть, если названия совпадают только частично или есть пробелы, но общая часть есть, что сделать, чтобы всё равно перекидывались данные?{/post}{/quote}Можно искать часть LookAt:=xlPart  
Find(c.Offset(1 + i, 0).Value, after:=b, LookIn:=xlValues, LookAt:=xlPart)  
и/или    
Find("*" & c.Offset(1 + i, 0).Value & "*", after:=b, LookIn:=xlValues)
Bite my shiny metal ass!      
 
 
 
#16
18.11.2009 17:28:10
{quote}{login=Лузер™}{date=18.11.2009 05:24}{thema=Re: }{post}{quote}{login=Natalia}{date=18.11.2009 05:20}{thema=}{post}  
 
Скажите, а как быть, если названия совпадают только частично или есть пробелы, но общая часть есть, что сделать, чтобы всё равно перекидывались данные?{/post}{/quote}Можно искать часть LookAt:=xlPart  
Find(c.Offset(1 + i, 0).Value, after:=b, LookIn:=xlValues, LookAt:=xlPart)  
и/или    
Find("*" & c.Offset(1 + i, 0).Value & "*", after:=b, LookIn:=xlValues){/post}{/quote}  
 
Спасибо ВАМ за помощь! Большое спасибо!
 
 
 
#17
18.11.2009 17:29:19
{quote}{login=The_Prist}{date=18.11.2009 04:50}{thema=}{post}Держите. Объединение ячеек - ЗЛО вселенского масштаба. Пробелы после наименований - тоже. Следите за точным совпадением данных в обеих таблицах.    
Макрос полностью переписал.{/post}{/quote}  
 
Спасибо Вам большое за помощь!
 
 
 
#18
18.11.2009 18:11:48
Скажите,а как быть,если у меня не один файл "итого", а  несколько файлов с разными названиями,но внутри структура таблиц идентичная. Как в этом случае перекинуть те же самые данные из файла "экономика" в эти файлы одновременно? Заранее спасибо
 
 
 
#19
18.11.2009 20:19:05
Как это можно реализовать?
 
 
 
#20
19.11.2009 08:54:27
Примерно так:  
Sub join_files_data()  
Dim c As Range, b As Range, flag As Boolean  
Dim a(1 To 3) as String  
Application.ScreenUpdating = False  
 
With Workbooks("Экономика.xls").Sheets("параметры").Cells  
Set c = .Find("Наименование ценной бумаги", LookIn:=xlValues)  
If Not c Is Nothing Then  
 
 
 
a(1)="итого.xls"  
a(2)="итого2.xls"  
a(3)="итого-ого.xls"  
for k=1 to 3  
 
Set b = Workbooks(a(k)).Sheets(1).Cells.Find(c.Offset(1 + i, 0).Value, after:=Workbooks(a(k)).Sheets(1).Cells(1, 1), LookIn:=xlValues)  
 
If Not b Is Nothing Then  
firstAddress = b.Address  
Do  
b.Offset(0, 13) = c.Offset(1 + i, 13)  
Set b = Workbooks(a(k)).Sheets(1).Cells.Find(c.Offset(1 + i, 0).Value, after:=b, LookIn:=xlValues)  
flag = False  
If Not c Is Nothing Then If b.Address <> firstAddress Then flag = True  
Loop While flag  
End If  
i = i + 1  
Loop  
End If  
 
next k  
 
 
End With  
Application.ScreenUpdating = True  
End Sub  
 
Все должны быть открыты, разумеется.  
Можно и поочередно открывать/закрывать - тогда нужно понимать где лежат, если их много, то какой-нибудь шаблон имени будет полезен, ибо a(3)="итого-ого.xls" замучаешься перечислять.
Bite my shiny metal ass!      
 
 
 
#21
19.11.2009 11:40:32
Спасибо Вам!  
Он почему-то ругается на LOOP, хотя вроде бы все верно.
 
 
 
#22
19.11.2009 12:46:48
Всё равно ошибку выдает.  
А если не выдает, то ничего не делает. Странно как-то!
 
 
 
#23
19.11.2009 13:30:14
{quote}{login=The_Prist}{date=18.11.2009 04:50}{thema=}{post}Держите. Объединение ячеек - ЗЛО вселенского масштаба. Пробелы после наименований - тоже. Следите за точным совпадением данных в обеих таблицах.    
Макрос полностью переписал.{/post}{/quote}  
 
The Pirst, а как в вашем варианте программы поправить, что бы решалась задача:  
если у меня не один файл "итого", а несколько файлов с разными названиями,но внутри структура таблиц идентичная. Как в этом случае перекинуть те же самые данные из файла "экономика" в эти файлы одновременно? Заранее спасибо
 
 
 
#24
19.11.2009 13:35:27
{quote}{login=The_Prist}{date=19.11.2009 01:12}{thema=}{post}Ну да. Еще порядок слегка нарушен.  
 
{/post}{/quote}  
 
Теперь и ошибок нет и результата тоже :))
 
 
 
#25
19.11.2009 13:51:19
Спасибо большое!  
Но это в случае, если наименования полностью совпадают, да?  
а как быть, если названия совпадают только частично или есть пробелы, но общая часть есть, что сделать, чтобы всё равно перекидывались данные?
 
 
 
#26
19.11.2009 14:14:24
Дмитрий, не злитесь, пожалуйста!  
Я же не профессионал в программировании, как ВЫ.  
 
А если у названий будет общая часть при совпадении    
 
Название:  
Открытое акционерное общество "Сургутнефтегаз"; SNGS; № гос.рег. 1-01-00155-A; АОИ  
 
Это название в файле "Итого".  
 
Общая часть в обоих файлах "1-01-00155-A"  
 
Так тогда можно что-то придумать?
 
 
 
#27
19.11.2009 14:22:07
Спасибо Вам большое!
 
 
 
#28
19.11.2009 14:41:57
Дмитрий, а обязательно, чтобы все файлы, в которые раскидываем информацию, должны быть открыты?
 
 
 
#29
19.11.2009 14:53:21
А эта конструкция, которую Вы предложили на форуме в теме "Как заставить код работать во всех книгах указанной папки" не подойдет в моём случае?  
 
Sub Auto_Whrite_In_Books()  
Dim sFolder As String, sFiles As String, li As Long  
With Application.FileDialog(msoFileDialogFolderPicker)  
If .Show = False Then Exit Sub  
sFolder = .SelectedItems(1)  
End With  
Application.ScreenUpdating = False  
sFiles = Dir(sFolder & Application.PathSeparator & "*.xlsx")  
Do While sFiles <> ""  
Workbooks.Open sFiles  
 
 
............'Текст программы............  
 
 
ActiveWorkbook.Close True  
sFiles = Dir  
Loop  
Application.ScreenUpdating = True  
End Sub
 
 
 
#30
19.11.2009 15:15:46
Может, что не так сделала?  
Но почему-то обрабатывается только один файл ИТОГО из этой папки.  
Дмитрий, подскажите, пожалуйста!
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх