Использую MS Excel 2010.
Сразу говорю: программист я начинающий.
Есть книга, из которой запускается макрос VBA, она открывает файл "old_sp.xls" (таблица со старыми данными граждан: Фамилия, Имя и тд., заголовков таблицы нет, идут сразу строки с данными) и файл "new_sp.xls" (с новыми данными граждан: Номер гражданина в выборке, Фамилия, Имя и тд., заголовки таблицы есть), также макрос создает новую книгу. В файле "new_sp.xls" строки с данными идут не подряд, а имеются пустые строки. Нужно найти в файле "new_sp.xls" непустую строку, проверить, что в ее первой ячейке слева стоит именно чиcло (это номер гражданина в выборке, колонка называется "№, п/п"), запомнить этот номер в переменной, и в старом списке, "old_sp.xls", отсчитать сверху количество строк, равное числу в сохранённой переменной, если эта строка не пуста, то скопировать всю строку с данными по текущему гражданину в созданный xls-файл. И так нужно перебрать все строки в файле "new_sp.xls". Затем когда вновь созданная книга (список исключённых граждан) будет заполнена, строками из "old_sp.xls", сохранить ее на жёсткий диск.
Я пошёл через циклы While Do...Loop. Пока у меня обрабатывается только первая непустая строка, с номером, из нового списка. Как сделать, чтобы обрабатывались все строки из нового списка и соответствующие им строки из старого списка копировались в список исключенных?
Код:
- Код: Выделить всё
Sub cbMakeIskluchSpsok_Click()
'Переменные для хранения имен файлов старого и нового списков
Dim old_sp_book As String
Dim new_sp_book As String
'Переменная для хранения имени файла списка исключенных
Dim old_spisok As Workbook
Dim new_spisok As Workbook
Dim iskl_spisok As Workbook
'Устанавливаем активным каталог книги, из которой запущен макрос
ChDir (ThisWorkbook.Path)
'Устанавливаем режим копирования-вставки
Application.CutCopyMode = True
'Открываем файл старого списка
If Dir(ActiveWorkbook.Path + "\" + "old_sp.xls") = "" Then
Workbooks.Open ActiveWorkbook.Path + "\" + "old_sp.xlsx"
Set old_spisok = Workbooks.Open(ThisWorkbook.Path + "\" + "old_sp.xlsx")
Else
Workbooks.Open ActiveWorkbook.Path + "\" + "old_sp.xls"
Set old_spisok = Workbooks.Open(ThisWorkbook.Path + "\" + "old_sp.xls")
End If
'Открываем файл нового списка
If Dir(ThisWorkbook.Path + "\" + "new_sp.xls") = "" Then
Workbooks.Open ActiveWorkbook.Path + "\" + "new_sp.xlsx"
Set new_spisok = Workbooks.Open(ThisWorkbook.Path + "\" + "new_sp.xlsx")
Else
Workbooks.Open ActiveWorkbook.Path + "\" + "new_sp.xls"
Set new_spisok = Workbooks.Open(ThisWorkbook.Path + "\" + "new_sp.xls")
End If
'Создаем ексель-книгу для списка исключенных
Set iskl_spisok = Workbooks.Add
'Сохраняем и закрываем созданную эксель-книгу со списка исключенных
iskl_spisok.SaveAs Filename:=ThisWorkbook.Path & "\" & "Iskl_spisok_Added " & CStr(Date) & ".xls",
FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'Переменные-счестчики для перебра строк нового старого списка, старого списка и списка сиключенных
'Переменная-счетчик для перебора строк нового списка
Dim i As Long
'Переменная-счетчик для перебора строк старого списка
'Dim j As Long
'Переменная-счетчик для перебора строк списка исключенных
Dim k As Long
'Переменная для хранения номера непстой строки в новом списке
Dim CurrNumericRow As Long
'Метка для продолжения цикла с перебором строк в новом списке
Dim Metka As Label
'''Действия по формированию списка исключенных граждан
'Активация файла нового списка
i = 1
k = 1
Metka:
new_spisok.Activate
ActiveWorkbook.Sheets(1).Activate
Do While i <> 65535
If ActiveSheet.Range(Cells(i, 1).Address).Text <> "" And IsNumeric(ActiveSheet.Range(Cells(i,
1).Address).Text) = True Then
CurrNumericRow = CLng(ActiveSheet.Range(Cells(i, 1).Address).Text)
old_spisok.Activate
ActiveWorkbook.Sheets(1).Activate
ActiveSheet.Range(Cells(CurrNumericRow, 1).Address & ":" & Cells(CurrNumericRow,
11).Address).Select
Selection.Copy
'Вставка ранее скопированного дисапозона ячеек в список исключенных граждан
iskl_spisok.Activate
ActiveWorkbook.Sheets(1).Activate
Do While k <> 65535
If ActiveSheet.Range(Cells(k, 1).Address).Text = "" Then
ActiveSheet.Range(Cells(k, 1).Address).Select
ActiveSheet.Paste
Exit Do
Else
k = k + 1
End If
Loop
Else
'ничего не делать :)))
End If
i = i + 1
Loop
'Сохранение сформированного файла-списка исключенных
'iskl_sp_book.SaveAs "????_?_?????\Я идиот! Убейте меня, кто-нибудь!?_?Я идиот! Убейте меня, кто-нибудь!Я идиот! Убейте меня, кто-нибудь!.xls"
End Sub
Прикрепляю архив примера (данные левые, нужен чисто принцип), плиз хелп
