Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Помогите с кодом (часть 2) Добавлено: 08.02.10 13:57  

Автор вопроса:  Блондинко
Продолжаю осваивать макросы в Excel. Как говорится дальше - больше. Сейчас поставила задачу следующую:
Есть две книги Excel. В книге "Один" есть три листа (x,x1,x2), на каждом из них таблица из 3-х колонок (3 месяца). Мне необходимо при помощи UserForm (содержит ComboBox с названиями 3-х месяцев)вытащить данные последовательно с каждого листа колонки "X" (задается UserForm)и вставить их последовательно в заданную ячейку (например C10)каждого листа книги "Два". Количество листов в книгах одинаково. Подскажите мне, пожалуйста, возможно ли это сделать, или я слишком много хочу? Спасибо всем огромное.

Ответить

  Ответы Всего ответов: 15  

Номер ответа: 1
Автор ответа:
 AngryBadger



Вопросов: 33
Ответов: 245
  Профиль | | #1 Добавлено: 08.02.10 20:34
Подскажите мне, пожалуйста, возможно ли это сделать, или я слишком много хочу?
Это возможно сделать, причем не вижу в этом никаких проблем. С чем именно у тебя возникла проблема?

Ответить

Номер ответа: 2
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #2 		Добавлено: 08.02.10 22:08
Так, и в каком месте Вам стало сложно дальше осваивать макросы Excel? Выполнить конечно можно и довольно просто. Хорощо бы иметь реальные примеры этих таблиц, а не виртуальное их описание. Выложите примеры двух книг на файлообменник, а ссылку - в этой теме. Желающие помочь найдутся.

Ответить

Номер ответа: 3
Автор ответа:
 Блондинко



Вопросов: 2
Ответов: 12
  Профиль | | #3 Добавлено: 09.02.10 09:27
mc-black пишет:
Выложите примеры двух книг на файлообменник, а ссылку - в этой теме.

Честно говоря, я даже не знаю как выложить и куда. Таблица простая - три колонки с цифрами произвольными. В Excel я вытягиваю формулой равенства - ячейка C10 книги2 = ячейке С10 книги1 Это если январь, если февраль - то просто меняю C на D.

Ответить

Номер ответа: 4
Автор ответа:
 Блондинко



Вопросов: 2
Ответов: 12
  Профиль | | #4 Добавлено: 09.02.10 09:34
Не могу понять каким образом мне обозначить множество листов в 2 книгах (если вообще это нужно). Сначала стала писать:
  1. Dim ws As Worksheet
  2. Dim ws1 As Worksheet

Но столкнулась с тем, что не знаю как указать где какой файл (имя).
  1. Windows("Книга2";).Activate

  1. For Each ws In ActiveWorkbook.Worksheets(Array("х", "х1", "х2";))
- 'с первым понятно (это книга куда нужно перетащить данные)
А книгу1 из которой необходимо брать данные?

Ответить

Номер ответа: 5
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #5 		Добавлено: 09.02.10 21:47
"Множество листов" - это коллекция Worksheets(), через нее можно узнать и количество рабочих листов в книге, и обращаться к рабочим листам по порядковому номеру или по имени. Например, чтобы перебрать все рабочие листы текущей рабочей книги - ThisWorkbook - надо сделать так:
  1. Dim wsh As Worksheet ' Переменная под объект рабочей книги
  2.  
  3. ' Перечисление всех элементов коллекции
  4. For Each wsh In ThisWorkbook.Worksheets
  5.     'Здесь могут быть какие-то обращения к объекту wsh
  6.     'к каждому из листов рабочей книги последовательно
  7.     Debug.Print wsh.Name ' Вывести название листа в окно Immediate
  8. Next

Ответить

Номер ответа: 6
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #6 		Добавлено: 09.02.10 22:41
На UserForm, находящуюся в книге с любым названием поместите кнопку CommandButton1 и комбо-бокс ComboBox1, а также вставьте следующий код:
  1. Option Explicit
  2.  
  3. Private Sub CommandButton1_Click()
  4.     Dim wbk As Workbook, src As Workbook, dst As Workbook, wsh As Worksheet
  5.     Dim b1 As Boolean, b2 As Boolean
  6.     Dim i As Long, j As Long, n As Long
  7.     
  8.     b1 = False: b2 = False
  9.     For Each wbk In Workbooks
  10.         If wbk.Name = "Один.xls" Then
  11.             b1 = True
  12.         ElseIf wbk.Name = "Два.xls" Then
  13.             b2 = True
  14.         End If
  15.     Next
  16.     If b1 And b2 Then
  17.         Set src = Workbooks("Один.xls")
  18.         Set dst = Workbooks("Два.xls")
  19.         
  20.         j = ComboBox1.ListIndex + 1
  21.         For Each wsh In src.Worksheets
  22.             For n = wsh.UsedRange.Row + wsh.UsedRange.Rows.Count To 1 Step -1
  23.                 If wsh.Rows(n).Text = "" Then Else Exit For
  24.             Next
  25.             
  26.             i = 2
  27.             Do While i <= n
  28.                 dst.Worksheets(wsh.Index).Cells(i, 3).Value = wsh.Cells(i, j).Value
  29.                 i = i + 1
  30.             Loop
  31.         Next
  32.         
  33.         Set src = Nothing
  34.         Set dst = Nothing
  35.     Else
  36.         Debug.Print "Должны быть открыты одновременно Один.xls и Два.xls"
  37.         End
  38.     End If
  39. End Sub
  40.  
  41. Private Sub UserForm_Initialize()
  42.     Dim wbk As Workbook, b1 As Boolean, b2 As Boolean
  43.     
  44.     b1 = False: b2 = False
  45.     For Each wbk In Workbooks
  46.         If wbk.Name = "Один.xls" Then
  47.             b1 = True
  48.         ElseIf wbk.Name = "Два.xls" Then
  49.             b2 = True
  50.         End If
  51.     Next
  52.     If b1 And b2 Then
  53.         ComboBox1.Clear
  54.         ComboBox1.AddItem Workbooks("Один.xls").Worksheets(1).Cells(1, 1).Value
  55.         ComboBox1.AddItem Workbooks("Один.xls").Worksheets(1).Cells(1, 2).Value
  56.         ComboBox1.AddItem Workbooks("Один.xls").Worksheets(1).Cells(1, 3).Value
  57.         ComboBox1.Style = fmStyleDropDownList
  58.         ComboBox1.ListIndex = 0
  59.     Else
  60.         Debug.Print "Должны быть открыты одновременно Один.xls и Два.xls"
  61.         End
  62.     End If
  63. End Sub


Рабочий пример (2 книги + 1 с формой). Скопировать текст в блокнот, сохранить файл с расширением .xxe, распаковать полученный файл-архив через WinRAR
begin 644 userform.rar
hIa3m6Fc5+1jEQkU+1E++++++++1SJbG+YX6+SlE+++-E+++08P0Dv7KoGHkR
hBEo+6++++6GWc0tsP5A+-D0-Y+6+g71tXWUdZB2AmC5+2+7KNiDLfqDVfQQV
hC71MsG1b-iPkT1KGEawb4mBlinUG342T5N5gXXplhkXU21N6-6QOEsKodGZ0
hrwQTs9P8-PGZC1Vkhbw28Ed1ZTk205Cq-7836--jxyGKOyChyKNauxT0Q4t8
hGqlNAr3WLYZt7SLYZt7SSHz2JtT79t7SLZzzzTTTSLgL12gl9AnRnUjzzgDU
hFVzE8++EYR9k4OEM1g7oUj0LNhoyd-KpZ2u-RQsKmFH2szRk+-hzDXxnqzuw
hFvMfkna-8VKBZ30JknaQdqWmscD2G3iR2ELOm9btDKTMz8o8hm7GUC64OjIG
hIf-lEw2bLT33ZAMCB551XlsMQUD-XkWV-C36SG8QCBSD21l6wIDYlsgT81lU
hwQCG5XFweD5eF6et5a2zXb-DEufUeau3J-tf-OgHz0kc2QDx140JukwHxK0P
hxBazCnZCavrxzSSMRgiUmIjssSJECPL8dVPE0SV8hA8ZG2RdrxN60DCkgANr
hl9-xn3jsO6LB0PWP2B09C0c-Qm3+r+gw9F-ytw535SYV5KMdMn-w2-RhrDYG
hrXkow9Ab9K-q9-5EdwlL17GkxL22pb85l8i2KwKe4-3p9WiLGF8tRAAJmqZt
hL9BXWjmnwmMwUD6XmEwaCI58XmUq+q6qGVXIgImstUQmBcCO5msn2rwgItR8
hvN8AkEhFadtPY9VG7CZ0j4N8NkQuDaFtcQwCT5alo+u2Tr-a6gtoVnkwyZKd
hC8R0EwqDvebjF8SSSG7qz34EoUuIRACb4v5cluEREBsDGZ7f1md6RCCe4xFT
hIDnK3BOdvuZ3xIEpu7BP8u+Vu2TF1pUyX5oUrksdM3NZL20y9ZDCWTzEhS3M
h24zP+VXNcPF6VTi2BljJUEcv36A2CLEP6B2AgUjzpf4uEWd1W8k+elZnU2U0
he9Wbkng4Mjn86Bk2AEVZlgkOxc29Fc2rmeEGzQ4DxGIJz28qL-tfkfCwtYvT
h1FEjzcHqeEDf2jqG54YBhDvYc9pob3WWReCmuHN7KDyqf6ctg3Dhs3NOd+gq
hs0arKQR+nqlBz3cNE8DS2iIwO3YKB1dU2BBI7IDr8VKp80jPjPmaUfpW0qCQ
h+jiv+eznj-cShll6gGKOqNVkWLBrTPTnc8u3tRfUcYLa9Sa+lyNZ4W38+oLr
hkBonma7L0Ly1+YUwmJwDPJ9xB7z62gO6VgyJ9PivyKWxjNRCV3YkQGpPjEOs
h99WyEnRtStUKMsFCe-xYWPL1NujYAcpC0nur8JnTgntv7T1LNykLaRnWOTAG
hwD7WW7a7kftdbYmErtRKF7NWVt6SE7LAScG222NCkDhMiT6KFjASyWGA7w6Q
hUyW-sBwe56jZRZFd5qia+KD1WItdLqgKWtu86Xm-WPpDkF5NRK2Yl6RTdChB
hJPgEt790z2qPEtM5O6Yj4h1U+JMWZA8++sx18VRAlA3d80MdSQ3SL+iZY2i6
h-Z32dsKxH9A65RpHtkWbYxP0jjXw3akFwX01oEWST05ZU0TX2fhh3Vyosct7
hj5d3jfThi1URtjTuHx9EtXF7CyF5YYjrL7C9sJo74CBGs3QGOo5bO6EQD4jG
h0iZGzSr377--mLHwMG30Rna6DatansXnFtDXMEr2uC3VutFidXnNoQYteWJI
h0IzMZWddsds7HpC6HWFDGbm1eSf2e-fV0AUDp+0CUGlCgWWSMDY-ThGETpf1
h3yCH0+eCHWi5GgcDyIDq6GlBvknck4dq71-5qkM7ul3l9J92+4yyKZvY7gKM
hXvIFCIm7TyA-UR13ZvYFAqNdGkzq1g8+frUBD809ysHDJ7NlhtcSQkeigrMw
hjAf8QnnXExBWWTqUrGnrkI3+Sfxc2gzcL8IysVHCTIsdB70kXpuaRP6vOQjt
hxp1WSUzeMrjOIxsjX6ZPZtmdcK+29Y3+89TAm48IYtR56k4kdCXfy6T571yh
hGIoERNoAWScEwgbz-L28m4fw3ih+EyuJmnAl2sVNWrLC86DEZ8Bs1N7dKOQv
hD7mtChGi75gM6b1wgK22feoAq4Dvx07UZom1hc4P9nEMwykTj1hL3uQoNdM2
hDDKEdWUDh1G1tBAPL0I31frcHlAoEaWPW8b6JbtR6lrSOK5xPV9jSN-5QH+x
hcwK-qKDa75ET9-Ecgjcev0OCCAOZtmtAoQFJL08vbK4n2qfeugSIidfVCpzB
hBx3auHHUomuyGxXTPYLaPjsRpiN8AKlurThuGhDu7Vo6IskNA4X4OZBG7SkJ
h95+d2yECtJUiMGolf6ncgnIjJZ9GJ7qpnhLGInMvftipROvWuRkyf5R7LIZ9
hIsHZ-IBeeRrHJB7p+ZQvHWzFbenIlXReufuhvPcYQJbc5SbevOutqtMCvVHb
hnyJuxjeOqXfbibSR+UtJAe-fJpnlvJ9lNGd2wdbZRQAqPkWVbVplWgpTn98Y
hvHVQWR81Sj1jyuAyAYmPqKG7BBDnbGfrpOuRv3PVxzWRPGy3T8QPrZ93zNQu
hH3R5ypdCxRqituBQpaTjQGL6La4fn9p5+giDnC6H6H2YGsByZt24awIRgHYb
huxC1K2B51-FOYKFhRqq4DTcoAv78UOPTUc-jSXI2T3dfREcb9VR4eaRQnVws
hSKkPBz4-1utFDquniJ11rO69gjcpCgW1td+dDouZ9iN-jH0xcu2B2gZCVQ9X
hcPjTk7PwrsRujrn21RlPiKx6TKbpMkBquBUoNA7EGx-QsWFscNXQxOJWYvm3
hlIJY0bOi0dMJWfN3FKzwK3MeE8lI6e8ZFM3Ggg0d+f3EWpOnDjWCyIv8gKdc
hrkI9me2kjFbobfsRt27yzcDryYNe8hOcrK-JIOfnX2xU5uFG87pLT7Cv9X+m
h+9pFh2Hd9pLysWbWsYHvhMle8uF4efW0CiBJlXaV7SJjhv91yltCxnLSBd16
hKDvdbw-9dayuTHnjugHBxpdgz7yjxnyi77SqxffC2s1MJF0ZD52i7nbS0Mr7
hMFC6fG2T2wdJcqNQFDuJl7PfBnkDHXz4twghr6xLYbvmDM10Sbl-DaJ-DQAW
hSf7TF0KgqWpicJYczKf7wd+bWBFg0LWriqzfSbsigbCnxbYj+yHwqMXWPShA
hMuGHD7YnwBdXN2RCWRU7CHFX7beG5eYHpObjxtHmMnQutySjFDM1v2TrlzU5
hy2TN1z2DglzX5qUzm1vITtFa7MvQVzADwszzVHr+yt5rEyv5rUzz-xuDjVzc
h5yYTuVvATulxyDk-y0DxWJ1oczQcAjrZDVZDw-y6DlFyADlp84lULYDnt7Ht
hEz95z2TwVvITzczA8TB5hVyQDyMzD5hlyUDyUzF5i-yYDop6rudLxQTzoVxU
hdxZ8wqIPYVxhDNgXDtezzj3DjeSzkYDl1yAXzrIwwOK82hACVy1SyIjm9Ldi
hNtTj8f6RPUy7AFZtVewYzSFv+MHoy87wlsHr1AbosYKr7NxMZ7oGHtGgbvRh
hGOgp-imku0SaerG3pO8CGpNLp7K5yNilen90R0aoXEyr33b5vr6H5-MnSFiz
hKw+6pNLdtpLIMfrF8E7CN7g7sAFOZPpbXBm48YHjQXf3J2F-zmtsZLrwAGpe
hChy11Y5OTLx3M9V1Byf9ObD0xr37LsZLq28fsw4cpTks3Xyzvjmev4AyD0va
h8xa9i5pbnlzYnzdMTtXlK7qrhF568xues5d1Jr5rj-rUjLF5qFmnsxy96SRi
hzwqAXwwxvDhz6hJiDLxHvAtvLc0EJ8nxrUjeCyihFPSSzzD0PPB33WTjsalJ
hzM9V+WrmfuN1z2MFSmDtdzpzMym7rr7FriaZ26fTNvoDW3xZlD3FYIPl6Wx9
hYhrV95uQLwKvkQZuQ63zLnUQtvtM1RWix1RvwpBnQPe7rYTwjodPzdQxT-2z
hk1ZGcarjI94A6oF4zKhyTTcTFwLp8v8Crz9bSbwJYiyRJ2goD1K9Qli9IMvq
hhgR+cWnHwJGI8xKl0H2vwZX4zB6w1SsLTzss2FONpZwci4ggYn3b+aj9VLHL
hyVUTtKYtZWS9XammC2H9y0Hp8+XXXY1VIiFfBP28S4882rRY44QsoDqJ2nBi
hfpNvUL9URMcFJUbch6zB69HWLUR-s8d2v3KWcU05cCSbTaej1nDUrdYcQfEv
hoNi4zAu8c073+PnPKsO+Iq5Iu7k2hAGaq5Hd-Ae1vIjnXPuWJ+ZUzdbS+8jG
hUtJyLudFOIHgVA4Ns+WZG5WwQDaOsi7x62+39Jbb0BaBfEwfXsT1T6C3rkSw
htBV4ZL1hPpTBESLaI5tj4mZG87Mkq5PA+Or6A+D05rg712BIuYLXKKbGckxp
hhpgaozJvodccktwC4PLapScnAAO9Ky7Gm6pEGfWGGgbtAbz1xA5xNaFbV8j7
hYZNjmPDwceQ76zFlpETkT-kkDsbkVC4Dzr9Yr6jxo3NNdnXsAivviXrTSzmk
hTAxluzIRuslbRwqbO2W3zaxOeqT7pPLxzjPL7pDy8Pqc9jXyQz-myBvXLI5s
hSRr8lRjOjeFzLw1ZRixUpPRXtyXlaOtbBPQPxMO3WqZloS3qJZgSEF01ejdb
hRGymH+Gd1aavPuDQM+tu-tJANXfJmXNamx6VhibuGaw1jlc4-n5uAPOZMVEp
hXrGiuOiMfSGhOfEfOubSp9jg8CpOok7FwwPlnDR-cx4wUIMHIaVbqBxiHP8-
hxndF3+93Yei6h2utyYeRG4HBMPpXGu18ahwlyPy23gmyQYKTyG48i3rhNdeq
hcRiuu6+-MZvIfpvdg5VvKbagi+sfPtAxI8DjWho4S2z7z23TSB+A30Nnx65e
hYXLMcXJ6D1bb+rl7uSOBm-1OyQ3xjACkrTjXPdEqRJYPUrNFEeiFJnZlPffV
hWbrG3h0oK83-e1MopR24mkqdwXdJNur9qR2bpVoWgW3QV35m0Jkuv2IKTnCK
hDKsK+TKDYupQkTVkifRQ-iHoHspsCA+twllzD0JN4Wn6NigyMAa2gn4gtC-S
hs0tsXHd-2WaBNXKIek+WvXL59oKUbQqt3EO1CoJPes0exrdqP8WJCvPc0pHG
hsqUbbGwHPIVahoZQwlHqe19SnhSu+XktSIrGqa9FjVDBk8apnfhLoTqBnPfL
hEaHaPOCM2I0mIZqwqqZ49-wlPmXRmuZrnfQBantl9DcVZgLHvgVOGgdBCjar
hU1tfO7l+TovoyeEJnw-OgSVSzR5Q2Nqcd+jhox3EHQrCVTRa94WoxOxiB8Sd
heQPg3qjbpv3elhOjc8LKvFSybbZ9+BfBK9BCfVuCpqsE3UxQewhRaQDQvjZg
h5OhfAVNFwfIirBUbRihOVpATp99yWn3K2MEHXQvLL3ZMOvRshiSuCWAbt47K
hIwYrKN88hdU3vHM49bbaCNDyxWFMdg9Z4DUWl4kJgifJo46rp1WAxX7DCsVZ
hafCb-ncS-Iq6QoBg9DDqfNnXw-yoy6p0jMHi6POLWAXCknKFpNmafx7sicy2
hpHvHQoR2vtoX-5FB6rIM6uF3suF3Nbn-px1Nqs-LbckSSXCj5QEFsCSn0Egw
hIR-rQLy6XnKVunAzgXTBcCzaNHcwjpLdGdmKRAsR9Cb0kHkNl28Ze3uFOFGa
h1AOzeLQ5MAD6N-8HcQt0x-Z+ZJgHKf7JtgXk+MzUaEulWcZW8jbRvADfSA-2
hsa0HtUAhxh05EF3vZ47C6L5xFDZWWevQrwucr9IjmmFk-8Sgbn00pA-oseIi
hGmBxzIVye3XTyEW2P-mZeu2R5f11QIjftjROErJxMUV24ySbjmOD0JwC5x4E
hqM3+eyJ0vuIn3U3gcA1z31b81AtlhoP4WQI2zDo4P-dDnfWqDCZ6GxBrA6Zp
hAGfaSbX1GeH3E0xKuVGPtCpvHhzjl8CNluTaXiovlV7kRsomQOIml5iO6BkQ
h0sBdbwATzds7qaTuATzCh1OIx8qWuUnhdMGgMKvkwYVmT-fbL8CQIdOseryh
hVS85ukVtEg1LXO1S+ZS5ovqwmZEj41JBX4DWPYOLyfJ2YUaBxictz2WvsaiS
hqyzZDetn2fj3xsBC2txbC9WbALnEkZSDOexIDnLXI4wTEPlY9luSc9xCXced
h20H7W5I8CQScIamTuzJj3LNyflikUeLrk1j4vDW8Xr8B-eHFWDg92LkQ6m91
hF0vKv0Oj4nD-JSBf+JLbH5lJSRB9MazeMQ7db6TgpsFf36h9MND1j7en0IFk
heVOz80beEbPWcBmC0bR4ho4XefikpsBjJunlhGrzVgudBlN2Wm6vDWXOVWRQ
htSGu3nABb1ZjAHQcqQnH4IZa9ap9FUnOKiRA52omMH1-iqNukB3RCLhBeRCv
heev9kFwtH5nX-FYAyd1vsCxAVgmHVcurRkvR57U72sveOhkx65RTL45sk-mt
hdrKJfkU0mLeklLyZeLPBZPEnafFglUkA3b2zaPM7hpBi7hauiFtRYuMi9P6T
hgorZ0rhlqoCfQBiKoL8TMCyNQKnC7NlAC6-v0KhVNGv+rRhUDFFnYsx14Yif
hUesydvUFTCpKXSwvP90aElmzEgqY-pnAGn0IU8nJcAM3UIirIgnZ9P4kIj9L
hqb9hhNZED4Qf1nq2T2f5QB8Iv0Co4axZq4HLkjwshbGdhLmuAVgmOYuwgE97
hW1frV1dXxKtuPwiyyaUe3rSxQg3YiKw1pa0SkRF8Xz-oMeQI9Oo8ZuCcHr01
htBGQRKadBCmGku7sVtWp69PPbsxvwDxvvxpl1R51mJkRGZHvz5B5+dk1BlOr
hh7NFHWg+gsHD1zGwvoioZQGiv1w71YzdzGFPREkkJI8JjKR3eIYZGaY3Hc79
hXFaIwcnXL0S77AGCl7dvXn0LskCPdEFdaRCEYWaG2HgmcW9xW1H+43ns6B3N
h9kaZeOhF8L9ygYA+GbxZ0N6xAXX3aXZ0xwYadZA2bid3mOa6TfdIpDeuhGk5
hMeK2qNOMi59VH9iMvZg2Z4UNkPnWpmMGO8Ox7fLgIz18+aafaNclKdQRjfHt
hKBCf94mJ9Iu-LazbWZ+3xtkrNGoGO6Pj9MKViFR7CQfbHLwtJyDaaizp+iE-
hbzs+bN-oY76q+6IG++++J++++hYZSLS9h2Yw5HIF+0++++0Ac8fUfWtsP5A+
h-BS-Y2+y+U1kkAoLqz6ufz0NuEf39QmuXL2pz2OfwYJ0-sEq6sFjH+Mofe8z
htlmOfyHDQbljqr56wkZDqUfzDovfyrQy4EhQPGN+aXv7YuWE7kR0g7pWtGkh
h4jugXYD5VdszuosWXZ9KQ7ZBZsKM7fFw2Or6jnUtz6grCDmJQuIZuOf8GnJl
hGJQyIZsKo7tgqUWx2V9nF2KJ7nucZrxd-YgtOtQz4ANDXM2JzCE2pWG86iZP
hJp3Ti9gfwh0JBN1ODGnWNLla1SNUXvhk3bTlDyq8y6EoF89db-pRz9hkSwLR
hFjUsrVqw-dhfievDF6QmGJrVQfZ0Nyzud9WQQM3Lt-m4WrlWYXmxGg7WgnEN
hLnsMnsv10JthFAmju6t3FBtTVJyMIVaw5kjAsKyl0D-QYDsMsYCDWfgUYPCC
hOs5sr1xLFeDhtJsoiB-v7153L5LX9oiMLsiAqCQ7btDkQLaAsetN-Qzt5JKD
hGKmrT0iGN22rw-ZSQO8KGnTyoteusW-fzAm5uq-5IAHQFAqjblHvwthFlbnQ
hEKM5bILHk5I5nA6iu-f+TQWbVHl0W5UMCneJ2ErPVtfLtdV9pA5tF3jaf1ed
hGRPfLPBPRnRQuxo1BTxAmwhWEmz2j3JwAsbwjXWbJdu39pbVGeHRpTT3G9Nu
hx87JC+S8NsZx2KKT3FhZ9XDZUGTE-BbBWQU8vItoJ2+tenPxTL2Cb0GaEe81
hjquOXFc3Q1KZ8O+-uR7JouY5BvkLMuGQ8iP675BVL7mY91VyNQHQ53gIgFqS
hrt5SCMHHqMOj9bSK6nd6G7EHd8lQasJ5Yp4B3+V3KbA6gsGcoIBkuZg1Jt+b
hboWSferZwnW1YshVLWNLubGQ9Q2XQHh39wIm+dBDn97IxB2afEXhoUNdyPDQ
h27WLAk8KGV3larFBxndnkbE1nEkXOXJxNq45t8UBBS8bzo2u9AxiJRFbKvb2
h9iaZHuDetz-S0P1jnQYF+ZkbTX9I3SAhHkhWBNrVJF9CJ7TaEdcgNwZT9Ll3
hsifMtkYeQKd0yAuIO9xOGKN1daIsYyyEeqTwbIdluM2In50HzaPwsuVzrzY-
hh5vn1vMe3T57zPmOXSLuejWQrrD+y9BQvIOuAUq9J-mTpSbIy7k55vjpBCtw
hKbpIV-Rt5hL5BxhVDFPOraprLtTmzVLa8dIt4qM2XZXe+VwEqkaoI4F9mBfE
h9DheockEXiZkl41Jewe86ISb9iZpCY8Ai7J-Q5ab84g85L9oUQ0EIxLR7HJ+
hCRpvVbF31cGgXiW4R1JyyQVFWKRh34S75FjOkUoF6j+0eKuxEjjxT0XeSSpE
h0xpQ9reLfqf6Cx74hfW9jmFfeVq21k6IJNs-twO27nJJ1mdRzvvmSp36NyhR
hpYqxfBClm5dqiWFHyRBuJfWCB3m0xth+kQQDRDGjKvqjMwhud-4axhDGJJCr
hpBRLDPYzchkNnUkhcb+N3vdjuvx2MAYYvJD8ttQ0jCURmxA+a2VS8V7-neRo
hOUWhf8PaDG0Jx8gG5IBmZaqmbiTgjolaaedRBxrsG-Od+icwyXas9fNKKWPu
h8tkfB23TKZbfeUn-XWhuTyA3oV-qRoR1jWWA7EaHKp4bhcDEdKCmcYj99fW4
h62sIJjVgtghPe2GKPf0YeupG0v+faPxWzR33FOnx3G89j4-3aTcgljQet5Rg
hGscNIiuGgrLb-Mw82hBeSbbOtrdxUj+gictO7mvoR7eOaiojYEGbdo9VXShx
h1r6BUoW51ideOr2RNRC5B-OVrviO820DbOVveZrnrEKnhRevU56RCIMB3Y-O
hDHdCHagSpParJJHnmhfeLyxoLyBvnhJHiuzuDi32XS9LxCpqxrOLemE3dJ-p
hxugLeJWorhu1iRiIiYqFEQUwcplj4Zd03K7AluLyMNmebOFivefbzPT5R0wV
hyQeUiU4DJDb9W1GCxfp3pE9CL8xPz5DdKSbideetVnsFJRDLIyTSVhovrhW2
hwJmBXx2+ZfHoeuud6Gc8rjXreNg1B4avWutq48Dir8jtTpFt5jVJ9YvW-lFk
hHZbUQNCRMZXjFQiGHa-o8fWIZcs54v4t-8iRK5ilXbwXj0alnpD0fsKbAv86
hRoozuHvAy3saLZAZraOzYHSB3XOCiNlfbygSuz3FPLJQv8Rxo5qwbEYGGffh
hMCmrqdWyvIt3e2ZKF7+y2p+iAgINAxBCmQeH2W7kYQAD31LXtIQaD7eTlkEF
hwoN5M2WoFXZVhFnku2SS5cFoEuARCCc5IXelpkuwTF1iyUniDin8lYYoN-+N
h31a+uZ2GsAdqkN-7POuGQqsaOWL0qZg7a+FPhNdSNcIoYZuRMZ37cYsGFUBY
hYLwN+0aLtB39B6C32oYUk8bG7N37dKk1pNe+7u3dwP75HehIK-gYS9T5uquk
hQO3E-UGiYgub-FySDYoe58eXj681vpRWpIIjNRxY+HXkuDBVc-iwpxrkeEM7
hHO-y-Ci3Xfih5Kw7hmBtLZdSY86qd3GMwSY+QLNw2Xcfh+6CwY5Ia52cWi5n
h4juJWZ4JsRq2B4eDdQgYvwyWQ21WX7n-4fWIceHDsL689IkpGnBsSFuIZacj
hHjF5f0abF8d4TbXpt1FYpoeIHcWoz0+GMJI6DjN8OFtAzfo2nhN-E7ip0EkC
h1LZhyGVI-iGigVW2UtrlJca82bEA3JRBI921j06eMNrThRQsIoEB4NEX4UBP
hfbNyuZ5N4B2uCvDwgX6-+nsD2hdgcy0OR85eNMLXHiRyaiVdzdC7vxtvMvgX
hf8ya9+0ByR-G16i9xDgtUZiGphgug5bsHWdMVW04VEHPldVxbZV6YDeYN7G1
hp30pfwL0xiJMWUPqdlUgAK0n10l6dAQL+TWFBLwQK8Q79FYQpBicIWQ00A3J
heBktuFLkcHYFRYX9gol-MGJN6-gtk3PNz13WkkshY9I0qspoY-qhqGXiP1ur
huIyMe9Vcb3f5t2cAn07Ud0SL1Bi3W0PStjgqkIWMTlBrjp-NACPkhIoOq89a
hPv7GQXEZecCiM8Nlys8xTv2g+-KPgYGUE4IrvrVpxpXkkfee5nxWpCm2GFMK
h-KO3UJdC2vsgKV79JYQecF2YM6iJRqc0iMQ9+TC70+rocgB1Bu2Sl6wK+Wqd
hMkBzJ9-8V8wF7BezWUZl1uWzV077-ACnXex04pgU5RUTMVyn-tY2Sz+UbRrb
hcYvlzyt1ZVNMwkDyFi1hX-KA2fCzO32ztyvwCvZOydfPUjh-ONGxzrHz2Wwf
hrBmNy+OLOIHtUx9UpUnCR3jY1HgqXql4w6Ve1G+VnOXKrWWAg5Rdc76Dy78F
hhIy1pXJLCQ3ukMoZb+fyHyrjvjupzhzLji+jyHTT5j9HygTivjtDQrbjTrxv
hRXLkFj9zVLkFLuOEkjDPhKg6kPvsFo9i5b9ZEcGq550aojqQ19HiNSNDHVHQ
hy1-5s2UpFAR6yuG5837pYlNgz9ZMEYzTC4Iirz+VFWUpVqFmRMpWEC+Xmke6
hywolSG+s9L22VNRseLeGglRJtf1RWqM7VvYHozAeEriUmazkwYELSrSMYNXh
hFEjGzHSvEXI7KGKDKhC1DTvnGsIcZX02pCw22zbD5dosOSIt4m6Dwq3+bw9L
hoERodwGE7FCbI9XWgb8vEOF2pOdCWRE5YoWA721DGU906dnjqdNQTskorlaE
hHHjGd2LCj+5FEVthHI7JPdFqyvShE5RITRBx8Ip7y0V3jA89vsP6No3a7nLn
hmEH1YnB5GdG8iT1rZHsQcaH6Pf+Jz0DHhVrOJD4pGzNBIF4DPiUSVEUvAiM9
hkGKUEyV7dcx7FYYhKjUqvRTA+m4AtiPRGwk4FvB52n9GYg4Fua7FinRHMN5o
hqNi7RbNsdeOZbKgu3W4Fhi4XZgrZ+m52muhpAvNfSgorZoEuODaHW+4kRAka
hqpYNHdPBgskveWAxauFM4reCd8ZlMI7Ej8lJ5Wr-BAAx61cqDMNtrQPdPSYv
hf25bDzUY5+PBh9BCwu1eb6PBg9+qxKM3JUJe3x7DgS7TbRHGfkE9MI34zpuG
hBkIVddBRY9QWxDF39kFFVSqfJw7BOLtBS0C7kGmbfN8ih22OF299DbbPitsW
hATGgHchi8r60GMefQqHdKGm7WNdsqW7tvqpJd9MB9g1ufdXyuJ9L-kd59fqw
hxmvP-lDZ5yGfOxMjR-chRtfa2vJRCkfRT2vHZNpPcncaJwjgn3Rl48iGGzDJ
h5+RpKkWhOhPsVJJOpJh-HPdffdtQ-Nn0faKjayXJffYRTCuDmQDsKPRpu5AV
hcSMZhM8znq4NkIY0EPyFcgj2gy-7mIr8CRCqt6tPh5OpPAl59PK8zYoofLZf
h1LL9MXO0eJ-7Dl7d73yGu7SlWMfMNtxLjgxPUZTOPRDfhLhQzfJyoKpEg6pp
htwe9Sdd-ukZEFzZx6znEfNJB6BfWi+PPvLtqiRpOzhNHOlioWeEKhZ8qcd3Z
hVKmRJY7LDBQS89l2ZtAj+9Mq32whrx6pXh7VPb1MN9hnfRDxZHm6g3X9B5iL
hezEJ4iSBSUS9whZpzJhdb4KzwZIQd7hfTKDU07dOaHSNC-InhON9HyXOOvO8
hjTDojibt8BpeouDuRtddLO5nkOFakW6bjQDw-zRCAqxfeVtoJlbaZKuPQmeP
hMzM6COAqa2mfvLWMmI6mL3-AW3-Aa-EH7aZLyLakAZcXBNa8RQ0edxS07yhu
h8rVMRNyXfHiszUdcfE2pR+vvCq0afJxZVxXtAPiI99LBjlqTFvT5pDbqZqwj
hqyFPNyZoqDuf5QfoYSgF3BW4erOQdjRR2udlmOzjOnRF1ODWPVqbdxaNBbA5
hg6faqAFcKX57fuAszEwchSuPbur6RRV3f8JoKMYHiPm58FoEja3mr5H3hH4J
hnj8pqfYhLcxDpsbBNM7dcjyiTyIzSnJ-Zpv-ITNAIifCnp7c6bQg73LiQJX8
hDz92Lz9gdlD-JUWQVNTzTCOwVWpL4HTi5EgflUi0+ZCNvTNyRjDAwoMi8q6L
hzzbyP7HHF3HoL3wchjrzEwutDa-7JU-OKFsXg84YRXkpKoyBegyM34b8plhb
hDSu0gJmxKWNjY-bxm7n9Gv7p+KZ3ndUoaneBh8B+HpuIMAdWpnVf9CK1Rj9M
hQ6gnv7U0jnItmrKByHLq4WqqDmUge8GuBXME+wLfx9CuVgVCOVVhq4glhj1I
hMqkWrkjEvKLM0q9u8ohi3hVVBqY+tZAi7cId9L6vGo+YkR+NOE9KnUHNnBn2
hhPInEPmylaAwubu4WLQorRILZHwevfsqbctQK7T4qTS2dgyeVuiTkLUvHPlr
hYSO4Z5w5t-nj0sQAbrOe8fB9UKhLOedG+S7HNfjjY4PMzn3WGpe7Byn5mDFb
hpKV4JgfqCI8WdhwHIeMtbLT9WLF63PidtJa6n4OvMtn7FYIjXRaPKSDPOxh4
hG4oCp35akgJwTExj4yMUmlsjFEmWuNXbj7zYuZrXJoapiCFMr3xjYVM2MUj2
h4KSFObDw1b3Oi0yzx7V6QA5e92vOspXx7WxsD2IIDWYz1L8Bn2yTf2nXv7eX
hfRSxlFFo7sYbiLGsUmyvVDTpTDIZE4VqepySJGnHOEBqVaYAkVn04JBh8mrE
hbU2rZEauc3GQGp77pF70gZnQrVlEhTS+PMvcsGLNFYoVdXG2oLb871XjmvuV
hh2Qv5Xwm63U-YAe59mxsS5JTVhVBpsOEkYpGEzHeslRoxDNkKOkP2AaUfy8V
hxwounaRbO1BftS+ikX3fRrd5ZIju3lAAaolBHP0IMn1Zk0hjHeIabIoo4qgy
hLaNNh9HSgLaq4fWxJS74wX9w4Qyz-zXt-EeBhxaPHrENRzO8fQ1yRArD54JO
hy4Ia2JTWSTYAEhzp0CDyIVY3AbzBYdfklrOn536ZksciaL1iGUvBRmGM8dSC
hueib5PnGJ3QHFalNA6NwbbSXffe8oh9knpbbhL1Fn9AsRvo1mbfeUYYmlHXE
hP+WTSox7IkoBg+vtMqp77VSid8minxLEjOpsYC3H2+Vk2SPXmUpJJO0EDDOi
hfRUgCjnJfveFqoieebk3k1tTxNSEeGi9g5uFcOH17jAg49CIMhXNWyrPi7Fh
h9i7OIa7eLMiaHNima4AqLZoB7HOOYoXj9x0qQHIqm-N-9ddAn8VZtBn-8EB1
hd9aZlIqVKtS3DjleKMTNiKQquMHBgf-pQxmoDqcgkxQIhbInQymnGPZqJlSb
hqaglglPgNdlAHI-CKaam8QBzxpKMTVITwj9Gpg2ioTWNUHqU3+35rPCNAUva
hUR7VyKRkmILx97sm95mz0vwvgjSxw82cCUjNPAbWTyFKdbZyRyHkmD-muWzq
hwcZD30nAvYbIbLGn2Mw5KNtCsFWgTtzm6Azz+81HR70GAk05-++++2k+++6c
hdiVLa9F7D-op1U+U++++XeGcfGtsP5A+-D00Y+6+w21OGTzvg+FHzE4++F+5
h6ugz0NuFM7BH7bV0jwWp1v7Oq1IAr73ErAl+DxfZ2zby6Ptzk3TwwXjoTimz
hv7NyHpDpLMUjC90jY7ciZVB2vnicsbs6sZakoLuKbXkow9pg8T8jVYdjDas1
hHzhDcz4NGzkX4NZpCIGL0B2WxAO8Gn4xuVHmXnbuzu9uDkBc4Wy2aGLTqY4G
hnZfZnoMlYyci7pDb2aomoQJ42s4PGkU8oingc3oX69dde4di9TVr8cGu16DG
hq18Y80RuepnR++zeBIvf8vJUod8qboSYe-x-LorDohJlbyY4tdqyc8MlOHln
hIZAG6awQGeTUDu1vaQsUZJLULu2SaxHYUse92eE92eB8j314KXospMQwp1xT
hR2FRrgKduHqO-V-ITOvdeW4jtW8kvUUFUUFZuHfql0W5rS6uF0UnraMG4dez
hGlyugYBjL4RR1fIJC4YDI+fvIUDej3YEulF5sm9MPwEZB+YuVRv3Zva4mXsi
hTYxE6Zu9+rokO8j90sDngQXrOCTYmta7PlVyawuPNv3wGflULDYGcW73jgll
hfyZwkFAKV7y3+a1H2ukiDd0mwXeqw7rz6vxBsHDGSZuPNyxZWLbZTEQVXx1r
hYts5aRxpqCqSqwEZpxQT4TBrbWzRQTaQvOhxz6uPa0LhtVewmxFnoaTYzV32
hgQmGKK1hqLDlYyll7YQlbXQXjw3kbXbssmTHyLssnXkVEEsvTHSR-1Gb51yC
htpF1Vpj5PYiS0EsdGsywKs0CFv6sHczydyaKtQTWGsneDxBzBwU1qA+iuVrk
hAqN8xv94SpwoMLRgiYV2aSff99WBbv7pFdsnKxjbxAbiAXuQaarxZSIStWVy
hzVjVgi4XboFKkesJqzzVBZPVunKMOBbQAYJv1RwkWqArHyFDjVcafPv8uWw1
hIoGgXi5kTeMwzXuCPmAgP3NRWDtQ43-3vTXtz7gt5fX0TmNYyllNx3sXbsmN
huHDmEjtx-t32QvVm+4O0jXu2-zKuPNYhH-9zMjWPxvGHFObjNMayojUJ3pMn
hlffyDUu9LafsWoLJp0TwWwHWAWBkzzBl7x-8sYzXZzYNMMZzlNx0YzbkTbex
hl5failkwJEirCrtm1NOtPLpDnSrwjrtvlBN8TXlS6xdT-RzoTfqDkSUmNhin
hx95Nz-zbbsDo5Wpl7NXtDTqbAurP5SLhCZzNtdAz4H5WWNyH2uNRgmR1gLl9
hzrggGXRGqAwMZDI8wcHx2FkHez5o4ZHkzu1LESl9MOYkzonTujIyXYz0fDBt
h6ZFD-TCA5nzYIbm-RYKx1vS3te-Ssx-DXaV3vLoGTVjlznL+ysdTAWz41u9L
hTAIBi2DT4nu93mCzEMVYyNSBdaGqflhDcj3mb34k1T49u-m0vwHTECoT3h52
hokRH1FX8GnWLR22p9GwdBHPGNZ4v7knadVYlZqool7vo3OOQiaV+lOCMThFK
hhyNNH9-jArBP0Pa4OA3Dc5eOQBkJcyMCIJACjyZyUTVMTwtx+tlkJjbg2vrq
SyDTnzbj3wGyvLOhCD5oHXzDmRrNbzt12DLg+E+Q+
+
end
sum -r/size 3349/11325

Ответить

Номер ответа: 7
Автор ответа:
 Блондинко



Вопросов: 2
Ответов: 12
  Профиль | | #7 Добавлено: 10.02.10 10:17
Ого! Чувствую, что не осилю я эту науку - написание макросов! )) Огромное спасибо, за Вашу помощь! Вот, посмотрите, у меня есть такой код.
  1. Sub макрос7()
  2. Workbooks.Open Filename:="Один.xls", ReadOnly:=Tru ' открываю файл
  3. Dim wsh1 As Worksheet
  4. For Each wsh1 In ActiveWorkbook.Worksheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10")) 'перечисляю все листы множества
  5. wsh1.Activate
  6. Workbooks.Open Filename:="Два.xls", ReadOnly:=Tru 'открываю файл
  7. Windows("Два").Activate
  8. For Each ws In ActiveWorkbook.Worksheets(Array("1а", "2а", "3а", "4а", "5а", "6а", "7а", "8а", "9а", "10а"))
  9. ws.Activate
  10.  Range("C10").Select ' обозначаю ячейку в книге "Два" куда нужно вытянуть информацию
  11.  'If ComboBox1.Text = "январь" Then
  12. sFormula = "=IF(ISNA(VLOOKUP(RC[-1],[Один.xls]wsh1!C2:C40,2,0)),0,VLOOKUP(RC[-1],[Один.xls]wsh1!C2:C40,2,0))" 'формула ВПР при условии ЕНД
  13.     For i = 1 To 19
  14.      ActiveSheet.Cells(i + 9, 3).Value = sFormula ' указание необходимых ячеек
  15.       Next i
  16.         For i = 1 To 19
  17.     sFormula = sFormula
  18.     Next i
  19.     For i = 1 To 3
  20.      ActiveSheet.Cells(i + 34, 3).Value = sFormula
  21.         Next i
  22.         For i = 1 To 3
  23.     sFormula = sFormula
  24.     Next i
  25.     For i = 1 To 7
  26.      ActiveSheet.Cells(i + 40, 3).Value = sFormula
  27.         Next i
  28.         For i = 1 To 7
  29.     sFormula = sFormula
  30.     Next i
  31.     Range("C77").Select
  32.     ActiveCell.FormulaR1C1 = "=IF(ISNA(VLOOKUP(110,[Один.xls]wsh1!C2:C40,2,0)),0,VLOOKUP(110,[Один.xls]wsh1!C2:C40,2,0))"
  33.     Range("C78").Select
  34.     ActiveCell.FormulaR1C1 = "=IF(ISNA(VLOOKUP(230,[Один.xls]wsh1!C2:C40,2,0)),0,VLOOKUP(230,[Один.xls]wsh1!C2:C40,2,0))"
  35.     Range("C77").Select
  36.     ActiveCell.FormulaR1C1 = "=[Один.xls]wsh1!R35C3"
  37.     Range("C78").Select
  38.     ActiveCell.FormulaR1C1 = "=[Один.xls]wsh1!R49C3"
  39.     Range("C79").Select
  40.     ActiveCell.FormulaR1C1 = "=[Один.xls]wsh1!R38C3-R[-41]C-R[-2]C"
  41.     Range("C80").Select
  42.     ActiveCell.FormulaR1C1 = "=[Один.xls]wsh1!R52C3-R[-32]C-R[-2]C"
  43. ' End If
  44.  Next ws
  45.  Next wsh1
  46. End Sub



И, естественно он не работает! )
1. Не находит лист wsh1 в книге "Один". Как сделать так, чтобы wsh1 была переменной и распознавалась я не знаю.
2. Не могу придумать как написать код, чтобы на первый лист книги "Два" вытягивались данные с первого листа книги "Один", затем второй лист книги "Два" и второй лист книги "Один".

Ответить

Номер ответа: 8
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #8 		Добавлено: 10.02.10 22:30
Сдается мне, здесь есть ошибки. Сама писала? Если сама, то респект - так ты можешь еще чему-то научиться. Если это сделал кто-то другой без твоего участия, жаль, но неохота чужие баги исправлять.))

1. Это скорее всего оттого, что перебор коллекции надо делать в Worksheets() и точка, никаких массивов и перечислений имен листов для этого не требуется - будут перебраны все листы в книге. Делайте так:
  1. For Each wsh1 In ActiveWorkbook.Worksheets()
  2.     ' Здесь содержимое в цикле, работа с wsh1
  3. Next

2. Почему бы вам не проверить, как работает макрос, что я написал - там же вроде не так уж сложно. Разве что местами хитрости =) Но это только так кажется мало посвященным!
3. В глаза бросилось, что переменную wsh1 объявляют ПОСЛЕ одной строки рабочего кода программы. Так никогда не поступают, сначала напишите все свои Dim, а потом начинайте программу.Обявления сами по себе операторами не являются.

Ответить

Номер ответа: 9
Автор ответа:
 Блондинко



Вопросов: 2
Ответов: 12
  Профиль | | #9 Добавлено: 11.02.10 12:00
Писала сама, не без помощи книг конечно. А ошибки от того, что в книгах нет подобных примеров, да и многие команды я не знаю как правильно писать. Код я проверю обязательно, просто я в нем ничего не понимаю. Еще новичок в макросах. Спасибо за советы, они очень помогают. Попробую изменить код, учитывая все Ваши рекомендации ) Огромное спасибо за помощь! )

Ответить

Номер ответа: 10
Автор ответа:
 Блондинко



Вопросов: 2
Ответов: 12
  Профиль | | #10 Добавлено: 16.02.10 08:58
Ребята, помоги, пожалуйста с этим кодом! Совсем я запуталась и никак не пойму в чем дело. На листы (а1,в1,с1) в книге Два он копируются данные только с листа а. Наверное нужно использовать цикл? Не могу понять, каким образом можно обозначить пошагово листы а,в и с. Пожалуйста, помогите. Всем заранее спасибо.

  1. Workbooks.Open Filename:="Один.xls", ReadOnly:=Tru
  2. Workbooks.Open Filename:="Два.xls", ReadOnly:=Tru
  3. Dim wsh1 As Worksheet
  4. Dim ws As Worksheet
  5. wsh1 = Worksheets(Array("а", "в", "с"))
  6. 'For Each wsh1 In ActiveWorkbook.Worksheets
  7. Windows("Два").Activate
  8. For Each ws In ActiveWorkbook.Worksheets(Array("а1", "в1", "с1"))
  9. ws.Activate
  10.  Range("C10").Select
  11.  'If ComboBox1.Text = "январь" Then
  12. For j = 1 To UBound(wsh1)
  13. sFormula = "=IF(ISNA(VLOOKUP(RC[-1],[Один.xls]1!C2:C40,2,0)),0,VLOOKUP(RC[-1],[Один.xls]1!C2:C40,2,0))" 'формула ВПР при условии ЕНД
  14.     For i = 1 To 19
  15.      ActiveSheet.Cells(i + 9, 3).Value = sFormula
  16.       Next i
  17.         For i = 1 To 19
  18.     sFormula = sFormula
  19.     Next i
  20.     For i = 1 To 3
  21.      ActiveSheet.Cells(i + 34, 3).Value = sFormula
  22.         Next i
  23.         For i = 1 To 3
  24.     sFormula = sFormula
  25.     Next i
  26.     For i = 1 To 7
  27.      ActiveSheet.Cells(i + 40, 3).Value = sFormula
  28.         Next i
  29.         For i = 1 To 7
  30.     sFormula = sFormula
  31.     Next i
  32.     j = j + 1
  33. ' End If
  34.  Next ws
  35.  'Next wsh1
  36. End Sub

Ответить

Номер ответа: 11
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #11 		Добавлено: 18.02.10 00:53
Сложно поправить твой код, легче все переписать:
  1. Sub CopyInfo()
  2.     Dim wbk1 As Workbook, wbk2 As Workbook
  3.     Dim i As Long, j As Long, s(1 To 3, 1 To 2) As String
  4.     
  5.     Set wbk1 = Workbooks("&#206;&#228;&#232;&#237;.xls")
  6.     Set wbk2 = Workbooks("&#196;&#226;&#224;.xls")
  7.     
  8.     s(1, 1) = "&#224;": s(2, 1) = "b": s(3, 1) = "c"
  9.     s(1, 2) = "&#224;1": s(2, 2) = "b1": s(3, 2) = "c1"
  10.     
  11.     For i = 1 To 3
  12.         For j = 2 To 20
  13.             wbk2.Worksheets(s(i, 1)).Cells(3, j).Value = _
  14.                 wbk1.Worksheets(s(i, 2)).Cells(ComboBox1.LisIndex + 1, j).Value
  15.         Next j
  16.     Next i
  17.     
  18.     Set wbk1 = Nothing
  19.     Set wbk2 = Nothing
  20. End Sub

Для правильной работы обе книги должны быть уже открытыми.

Ответить

Номер ответа: 12
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #12 		Добавлено: 18.02.10 00:55
Упс. Напортачил с русской кодировкой. Вот правильный вариант:
  1. Sub CopyInfo()
  2.     Dim wbk1 As Workbook, wbk2 As Workbook
  3.     Dim i As Long, j As Long, s(1 To 3, 1 To 2) As String
  4.     
  5.     Set wbk1 = Workbooks("Один.xls")
  6.     Set wbk2 = Workbooks("Два.xls")
  7.     
  8.     s(1, 1) = "а": s(2, 1) = "b": s(3, 1) = "c"
  9.     s(1, 2) = "а1": s(2, 2) = "b1": s(3, 2) = "c1"
  10.     
  11.     For i = 1 To 3
  12.         For j = 2 To 20
  13.             wbk2.Worksheets(s(i, 1)).Cells(3, j).Value = _
  14.                 wbk1.Worksheets(s(i, 2)).Cells(ComboBox1.LisIndex + 1, j).Value
  15.         Next j
  16.     Next i
  17.     
  18.     Set wbk1 = Nothing
  19.     Set wbk2 = Nothing
  20. End Sub

Ответить

Номер ответа: 13
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #13 		Добавлено: 18.02.10 01:07
Упс... снова думаю надо поправить, так как перепутал строки со столбцами:
  1. Sub CopyInfo()
  2.     Dim wbk1 As Workbook, wbk2 As Workbook
  3.     Dim i As Long, j As Long, s(1 To 3, 1 To 2) As String
  4.     
  5.     Set wbk1 = Workbooks("Один.xls")
  6.     Set wbk2 = Workbooks("Два.xls")
  7.     
  8.     s(1, 1) = "а": s(2, 1) = "b": s(3, 1) = "c"
  9.     s(1, 2) = "а1": s(2, 2) = "b1": s(3, 2) = "c1"
  10.     
  11.     For i = 1 To 3
  12.         For j = 2 To 20
  13.             wbk2.Worksheets(s(i, 1)).Cells(j, 3).Value = _
  14.                 wbk1.Worksheets(s(i, 2)).Cells(j, ComboBox1.LisIndex + 1).Value
  15.         Next j
  16.     Next i
  17.     
  18.     Set wbk1 = Nothing
  19.     Set wbk2 = Nothing
  20. End Sub

Копирует из строк с 2 по 20 в зависимости от выбранного элемента в ComboBox1

Ответить

Номер ответа: 14
Автор ответа:
 GDK



Вопросов: 13
Ответов: 348
  Профиль | | #14 Добавлено: 03.03.10 15:30
Ну и где комменты. Они б ей ооочень пригодилисиь.

    s(1, 1) = "а": s(2, 1) = "b": s(3, 1) = "c"
    s(1, 2) = "а1": s(2, 2) = "b1": s(3, 2) = "c1"

Для неё это слишком тяжело понять будет (скорее всего). Надо давать удочку, а не рыбу.

Ответить

Номер ответа: 15
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #15 		Добавлено: 05.03.10 01:01
Согласен.

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам