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

   
   
     

Форум - VBA

Страница: 1 | 2 |

 

  Вопрос: Выборка, копирование в новый лист xls Добавлено: 12.12.08 10:36  

Автор вопроса:  SoftBear | Web-сайт: softbear.livejournal.com | ICQ: 206956288 
Здраствуйте, уважаемые.
Надеюсь на вашу помощь, к вечеру нужно сделать рабочее решение.
С чего гендир решил, что инженер по VoIP должен разбираться в VBA, я не знаю, но "партия сказала - надо".

Задача:
Есть 13 файлов xls, в каждом 1000 листов. Счета-фактуры.
Есть файл xls со списком номеров ГТД в колонке А (150 номеров).

Нужно искать каждый номер из списка в 13-ти файлах, и, в случае обнаружения, заносить некоторые данные (назв. модели, кол-во, номер сч.ф., номер гтд) в новый файл.

Я весь день вчера пытался сделать через Cells.Find - ни хрена не получилось. Плюнул, решил тупо через "for". Скорость не важна, главное чтобы сработало один раз.

Написал - не работает. Вот код:

----
Sub Main()
'
'

Dim str As Integer
Dim filenumber As Integer
Dim listnumber As Integer
Dim znach As String
Dim testing As String
Dim tstr As Integer
Dim nomersf As String
Dim model As String
Dim kolvo As Integer
Dim itogstr As Integer

Workbooks.Open Filename:="c:\Инфа\Номера ГТД.xls"
    
 For filenumber = 1 To 13
  Workbooks.Open Filename:="c:\Инфа\" & filenumber & ".xls"
    
    For listnumber = 1 To 1000
    Sheets("Лист" & listnumber).Select
   
      For str = 3 To 150
      
      Windows("Номера ГТД.xls").Activate
      znach = Range("A" & str)
      Windows(filenumber & ".xls").Activate
      
         For tstr = 19 To 100
         
            testing = Range("K" & tstr)
            If znach = testing Then
            nomersf = Range("A7")
            model = Range("A" & tstr)
            kolvo = Range("C" & tstr)

            Windows("Итог.xls").Activate
            Range("B" & itogstr).Select
            ActiveCell.FormulaR1C1 = testing
            Range("C" & itogstr).Select
            ActiveCell.FormulaR1C1 = nomersf
            Range("D" & itogstr).Select
            ActiveCell.FormulaR1C1 = model
            Range("E" & itogstr).Select
            ActiveCell.FormulaR1C1 = kolvo
            itogstr = itogstr + 1
            Windows(filenumber & ".xls").Activate
            
                                                               
         Next tstr
       
       Next str
       
    Next listnumber
      
  Workbooks.Close
 Next filenumber
    
End Sub
----

Сейчас ругается на Next tstr без for.
Помогите, пожалуйста.

Ответить

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

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



Вопросов: 13
Ответов: 348
  Профиль | | #1 Добавлено: 12.12.08 10:56
У меня, было дело, VBA Word 2003 ругалось на то что несоответствие типов данных. Код был примерно такой:

Sub TestProc ()
dim i as Integer
i=512
End Sub

Вроде всё нормально, но ругалось. Глюк наверное.
Исправил dim i as Integer на dim i as Long. Всё заработало!
Лучше всегда применять Long а не Integer.

Ответить

Номер ответа: 2
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #2 		Добавлено: 12.12.08 11:02
Спасибо, заменил, но на цикл (compile error: next without for) всё равно ругается.
М.б. в цикле нельзя листы переключать?

Ответить

Номер ответа: 3
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #3 		Добавлено: 12.12.08 11:18
переделал, вынес запись в "итог" в отдельную подпрограмму:

Sub Main()
'
'

Dim str As Long
Dim filenumber As Long
Dim listnumber As Long
Dim znach As String
Dim testing As String
Dim tstr As Long
Dim nomersf As String
Dim model As String
Dim kolvo As Long
Dim itogstr As Long

Workbooks.Open Filename:="c:\Èíôà\Íîìåðà ÃÒÄ.xls"
    
 For filenumber = 1 To 13
  Workbooks.Open Filename:="c:\Èíôà\" & filenumber & ".xls"
    
    For listnumber = 1 To 1000
    Sheets("Ëèñò" & listnumber).Select
   
      For str = 3 To 150
      
      Windows("Íîìåðà ÃÒÄ.xls";).Activate
      znach = Range("A" & str)
      Windows(filenumber & ".xls";).Activate
      
         For tstr = 19 To 100
         
            testing = Range("K" & tstr)
            If znach = testing Then Call find
                        
                                                               
         Next tstr
       
       Next str
       
    Next listnumber
      
  Workbooks.Close
 Next filenumber
    
End Sub

Sub find()
            nomersf = Range("A7";)
            model = Range("A" & tstr)
            kolvo = Range("C" & tstr)

            Windows("Èòîã.xls";).Activate
            Range("B" & itogstr).Select
            ActiveCell.FormulaR1C1 = testing
            Range("C" & itogstr).Select
            ActiveCell.FormulaR1C1 = nomersf
            Range(";D" & itogstr).Select
            ActiveCell.FormulaR1C1 = model
            Range("E" & itogstr).Select
            ActiveCell.FormulaR1C1 = kolvo
            itogstr = itogstr + 1
            Windows(filenumber & ".xls";).Activate
End Sub


Теперь ругается на out of range в Sheets("Лист" & listnumber).Select

Ответить

Номер ответа: 4
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #4 		Добавлено: 12.12.08 11:19
  1. Sub Main()
  2. '
  3. '
  4.  
  5. Dim str As Long
  6. Dim filenumber As Long
  7. Dim listnumber As Long
  8. Dim znach As String
  9. Dim testing As String
  10. Dim tstr As Long
  11. Dim nomersf As String
  12. Dim model As String
  13. Dim kolvo As Long
  14. Dim itogstr As Long
  15.  
  16. Workbooks.Open Filename:="c:\Èíôà\Íîìåðà ÃÒÄ.xls"
  17.     
  18.  For filenumber = 1 To 13
  19.   Workbooks.Open Filename:="c:\Èíôà\" & filenumber & ".xls"
  20.     
  21.     For listnumber = 1 To 1000
  22.     Sheets("Ëèñò" & listnumber).Select
  23.    
  24.       For str = 3 To 150
  25.       
  26.       Windows("Íîìåðà ÃÒÄ.xls").Activate
  27.       znach = Range("A" & str)
  28.       Windows(filenumber & ".xls").Activate
  29.       
  30.          For tstr = 19 To 100
  31.          
  32.             testing = Range("K" & tstr)
  33.             If znach = testing Then Call find
  34.                         
  35.                                                                
  36.          Next tstr
  37.        
  38.        Next str
  39.        
  40.     Next listnumber
  41.       
  42.   Workbooks.Close
  43.  Next filenumber
  44.     
  45. End Sub
  46.  
  47. Sub find()
  48.             nomersf = Range("A7")
  49.             model = Range("A" & tstr)
  50.             kolvo = Range("C" & tstr)
  51.  
  52.             Windows("Èòîã.xls").Activate
  53.             Range("B" & itogstr).Select
  54.             ActiveCell.FormulaR1C1 = testing
  55.             Range("C" & itogstr).Select
  56.             ActiveCell.FormulaR1C1 = nomersf
  57.             Range("D" & itogstr).Select
  58.             ActiveCell.FormulaR1C1 = model
  59.             Range("E" & itogstr).Select
  60.             ActiveCell.FormulaR1C1 = kolvo
  61.             itogstr = itogstr + 1
  62.             Windows(filenumber & ".xls").Activate
  63. End Sub

Ответить

Номер ответа: 5
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #5 		Добавлено: 12.12.08 11:37
"Subscript out of range" даже если
For listnumber = 1 To 10
Sheets("Ëèñò" & listnumber).Select

Ответить

Номер ответа: 6
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #6 		Добавлено: 12.12.08 11:46
исправил Sheets.Select на Sheets.Activate
теперь ругается на model = Range("A" & tstr) - "method 'range' of object '_global' failed"

Ответить

Номер ответа: 7
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #7 Добавлено: 12.12.08 11:56
Переменная tstr была объявлена в модуле Main. В find она неизвестная.
Объяви ее как
  1. Public tstr as Long

Ответить

Номер ответа: 8
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #8 		Добавлено: 12.12.08 12:00
ага, сделал, спасибо.
теперь ругается, что инвалид аттрибут ин саб о функшион.
как Sub Main() обозвать, чтоб паблик заработал? Module?

Ответить

Номер ответа: 9
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #9 Добавлено: 12.12.08 12:01
А где ты открываешь файл "Итог.xls" ? Или он уже открыт ?

Ответить

Номер ответа: 10
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #10 Добавлено: 12.12.08 12:03
Sub Main оставь как есть. :-)
Public должен быть до Sub Main.

Ответить

Номер ответа: 11
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #11 		Добавлено: 12.12.08 12:04
А где ты открываешь файл "Итог.xls" ? Или он уже открыт ?


открыт, в нём и пишу.

Public должен быть до Sub Main.

спасибо, сейчас попробую.

Ответить

Номер ответа: 12
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #12 Добавлено: 12.12.08 12:06
В твоем первом варианте, ты забыл End If на блок:
  1.          For tstr = 19 To 100
  2.           
  3.           testing = Range("K" & tstr)
  4.           If znach = testing Then
  5.             nomersf = Range("A7")
  6.             model = Range("A" & tstr)
  7.             kolvo = Range("C" & tstr)
  8.  
  9.             Windows("Итог.xls").Activate
  10.             Range("B" & itogstr).Select
  11.             ActiveCell.FormulaR1C1 = testing
  12.             Range("C" & itogstr).Select
  13.             ActiveCell.FormulaR1C1 = nomersf
  14.             Range("D" & itogstr).Select
  15.             ActiveCell.FormulaR1C1 = model
  16.             Range("E" & itogstr).Select
  17.             ActiveCell.FormulaR1C1 = kolvo
  18.             itogstr = itogstr + 1
  19.             Windows(filenumber & ".xls").Activate
  20.           End If

Поэтому и ругался.

Ответить

Номер ответа: 13
Автор ответа:
 SoftBear



ICQ: 206956288 

Вопросов: 1
Ответов: 11
  Web-сайт: softbear.livejournal.com
 Профиль | | #13 		Добавлено: 12.12.08 12:16
Сейчас сделал вот так:

  1. Public str As Long
  2. Public filenumber As Long
  3. Public listnumber As Long
  4. Public znach As String
  5. Public testing As String
  6. Public tstr As Long
  7. Public nomersf As String
  8. Public model As String
  9. Public kolvo As Long
  10. Public itogstr As Long
  11.  
  12. Sub Main()
  13. '
  14. '
  15.  
  16.  
  17.  
  18. Workbooks.Open Filename:="c:\Èíôà\Íîìåðà ÃÒÄ.xls"
  19.     
  20.  For filenumber = 1 To 13
  21.   Workbooks.Open Filename:="c:\Èíôà\" & filenumber & ".xls"
  22.     
  23.     For listnumber = 1 To 10
  24.     Sheets("Ëèñò " & listnumber).Activate
  25.    
  26.       For str = 3 To 150
  27.       
  28.       Windows("Íîìåðà ÃÒÄ.xls").Activate
  29.       znach = Range("A" & str).Value
  30.       Windows(filenumber & ".xls").Activate
  31.       
  32.          For tstr = 19 To 100
  33.          
  34.             testing = Range("K" & tstr).Value
  35.             If znach = testing Then Call find
  36.             End If
  37.                                                                
  38.          Next tstr
  39.        
  40.        Next str
  41.        
  42.     Next listnumber
  43.       
  44.   ActiveWindow.Close
  45.  Next filenumber
  46.     
  47. End Sub
  48.  
  49. Sub find()
  50.             nomersf = Range("A7").Value
  51.             model = Range("A" & tstr).Value
  52.             kolvo = Range("C" & tstr).Value
  53.             
  54.             Windows("Èòîã.xls").Activate
  55.             Range("B" & itogstr).Select
  56.             ActiveCell.FormulaR1C1 = testing
  57.             Range("C" & itogstr).Select
  58.             ActiveCell.FormulaR1C1 = nomersf
  59.             Range("D" & itogstr).Select
  60.             ActiveCell.FormulaR1C1 = model
  61.             Range("E" & itogstr).Select
  62.             ActiveCell.FormulaR1C1 = kolvo
  63.             itogstr = itogstr + 1
  64.             Windows(filenumber & ".xls").Activate
  65. End Sub



Ругается на End If - "end if without block if"

Убираю - ругается на Range("B" & itogstr).Select в find() - "method 'range' of object '_global' failed"

Ответить

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



Вопросов: 23
Ответов: 417
  Профиль | | #14 Добавлено: 12.12.08 12:20
  1.             testing = Range("K" & tstr).Value
  2.             If znach = testing Then
  3.               Call find
  4.             End If

If пишется или в одну строку без End If. Или если с End If, то через :. Или с End If, но блоком.

Ответить

Номер ответа: 15
Автор ответа:
 Jasmin



Вопросов: 23
Ответов: 417
  Профиль | | #15 Добавлено: 12.12.08 12:26
К посту 13: После команды Windows("Èòîã.xls";).Activate, ты только активируешь окно. Поставь еще выбор листа.

Ответить

Страница: 1 | 2 |

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



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