Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.83/6: Рейтинг темы: голосов - 6, средняя оценка - 4.83
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
1

Скопировать только отчество из другого листа в другой где в одной ячейке находится ФИО

27.05.2016, 11:26. Просмотров 1091. Ответов 17
Метки нет (Все метки)

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

Visual Basic
1
2
3
For i = 4 To 65536  
    Sheets(2).Cells(i - 1, 1).Resize(, 3) = Split(Application.Trim(Sheets(1).Cells(i, 2)), , 3)
Next i
0
Лучшие ответы (1)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.05.2016, 11:26
Ответы с готовыми решениями:

Скопировать столбец ФИО из одного листа на другой лист с разбивкой на 3 ячейки
Необходимо копировать столбец ФИО из одного листа на другой лист с разбивкой на 3 ячейки Здесь...

Как создать коэффициент в ячейке листа, чтобы каждое новое значение меняло значение массива только в одной строке листа?
Дано: Имеется массив, расположенный на листе Excel 2010 в стлбце. Каждое число массива умножается...

Как скопировать только данные с листа другой книги?
Подскажите , как не заметно для пользователя скопировать только данные с всего листа из другой...

Обращение к ячейке листа, имя которого хранится в другой ячейке
Приветствую всех. Подскажите, существует ли решение следующей задачи без использования VBA. В...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
17
Alex77755
11003 / 3457 / 594
Регистрация: 13.02.2009
Сообщений: 10,274
27.05.2016, 16:53 2
на коленке писано
Visual Basic
1
Sheets(2).Cells(i - 1, 1) = Split(Application.Trim(Sheets(1).Cells(i, 2)), , 3)(2)
0
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
27.05.2016, 17:08  [ТС] 3
выдает ошибку
0
Svsh2015
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
27.05.2016, 18:09 4
вариант макроса

Visual Basic
1
2
3
Sub test()
 Sheets("Лист2").[A1] = Split(Sheets("Лист1").[A1])(UBound(Split(Sheets("Лист1").[A1])))
End Sub
0
Вложения
Тип файла: xls example_27_05_2016_cbr_отчество.xls (34.0 Кб, 5 просмотров)
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
27.05.2016, 19:16  [ТС] 5
хотелось бы код типа
Visual Basic
1
2
3
For i = 4 To 65536  
    Sheets(2).Cells(i, 2).Resize(, 3) = Split(Application.Trim(Sheets(1).Cells(i, 3)), , 3)
Next i
Добавлено через 27 минут
Получилось
Visual Basic
1
2
3
For i = 4 To 65536  
    Sheets(2).Cells(i, 1).Resize(, 1) = Split(Application.Trim(Sheets(1).Cells(i, 2)), , 3)(2)
Next i
но выдает все равно ошибку
0
Svsh2015
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
27.05.2016, 22:19 6
добрый вечер,протестируйте вариант для#5,можно для Вашего случая поменять 10 на другое число и заменить название листа:
кнопки test2 и очистка
Visual Basic
1
2
3
4
5
Sub test2()
For i = 4 To 10
Sheets("Лист2").Cells(i, 1).Resize(, 1) = Split(Application.Trim(Sheets("Лист1").Cells(i, 2)), , 3)(UBound(Split(Application.Trim(Sheets("Лист1").Cells(i, 2)), , 3)))
Next
End Sub
0
Вложения
Тип файла: xls example_27_05_2016_cbr_отчество_last.xls (41.5 Кб, 3 просмотров)
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 06:44  [ТС] 7
получается у меня в первом столбце 17 строк, вот выходит ошибка когда я пишу 18

Visual Basic
1
2
3
For i = 4 To 18
     Sheets(2).Cells(i, 1).Resize(, 1) = Split(Application.Trim(Sheets(1).Cells(i, 2)), , 3)(UBound(Split(Application.Trim(Sheets(1).Cells(i, 2)), , 3)))
Next
проблема получается, нужно вычислять последнюю строку столбца, но мне нужно предпоследнюю строку столбца, допустим если в листе 1 заполненных столбцов 100, то мне надо 99
0
Svsh2015
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
28.05.2016, 09:59 8
добрый день, не нашел Вашего файл-примера,код не зависит от количества ячеек,если У Вас есть пустые ячейки надо чуть подкорректировать код,протестируйте ,например, для 100

Visual Basic
1
2
3
4
5
6
Sub example()
    Dim i%
For i = 4 To 100
     Sheets("Лист2").Cells(i, 1) = Split(Application.Trim(Sheets("Лист11").Cells(i, 2)), , 3)(2)
Next
End Sub
0
Вложения
Тип файла: xls example_28_05_2016_cbr_отчество.xls (47.5 Кб, 5 просмотров)
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 10:11  [ТС] 9
Да рубит последнюю строку, но все равно выходит сообщение
Run-time '9':
Subscript out of range
0
Svsh2015
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
28.05.2016, 10:13 10
добавлю,если есть пустые ячейки,например,так

Visual Basic
1
2
3
4
5
6
7
8
Sub example1()
    Dim i%
For i = 4 To 102
  If Not IsEmpty(Sheets("Лист1").Cells(i, 2)) Then
     Sheets("Лист2").Cells(i, 1) = Split(Trim(Sheets("Лист1").Cells(i, 2)), , 3)(2)
  End If
Next
End Sub
1
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 10:21  [ТС] 11
Также выходит ошибка, вот полный код программы

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Macro1()
 
 
Range("E4:E65536").Copy Worksheets("Лист1").Range("E4")  'копируем дату рождения
    
 
' получилось не трогать
For i = 4 To 65536  'Копируем и разбиваем столбец с ФИО
    Sheets(2).Cells(i, 2).Resize(, 3) = Split(Application.Trim(Sheets(1).Cells(i, 3)), , 3)
Next i
 
' получилось не трогать
For i = 4 To 65536  'Копируем сколько лет
    Sheets(2).Cells(i, 6).Resize(, 1) = Split(Application.Trim(Sheets(1).Cells(i, 4)), , 3)
Next i
 
ActiveSheet.Range("a1").Value = "pacienty.dbf" 'Скопировать слово pacienty.dbf
ActiveSheet.Range("a2").Value = "N6"
ActiveSheet.Range("b2").Value = "C30"
ActiveSheet.Range("c2").Value = "C30"
ActiveSheet.Range("d2").Value = "C30"
ActiveSheet.Range("e2").Value = "N3"
ActiveSheet.Range("f2").Value = "D"
 
ActiveSheet.Range("a3").Value = "nib"
ActiveSheet.Range("b3").Value = "surname"
ActiveSheet.Range("c3").Value = "fstname"
ActiveSheet.Range("d3").Value = "otchestvo"
ActiveSheet.Range("e3").Value = "birthday"
ActiveSheet.Range("f3").Value = "age"
 
 
 
'Копируем nib только код
For i = 4 To 102
  If Not IsEmpty(Sheets(1).Cells(i, 2)) Then
     Sheets(2).Cells(i, 1) = Split(Trim(Sheets(1).Cells(i, 2)), , 3)(2)
  End If
Next
   
   
 
End Sub
Добавлено через 33 секунды
конечно пока в черновом варианте, наброски
0
Svsh2015
132 / 108 / 22
Регистрация: 23.06.2015
Сообщений: 339
28.05.2016, 10:35 12
нужен файл-пример(что дано,что нужно получить),а не только наброски кода.
0
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 10:37  [ТС] 13
щас скину
0
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 11:07  [ТС] 14
вот скинул
0
Вложения
Тип файла: xls 1.xls (38.0 Кб, 5 просмотров)
МВТ
45 / 45 / 15
Регистрация: 14.04.2016
Сообщений: 128
28.05.2016, 11:35 15
Лучший ответ Сообщение было отмечено dmr12345 как решение

Решение

Для Вашего примера, как-то так
Visual Basic
1
2
3
4
5
6
7
8
9
10
Sub tt()
    Dim arr(), i As Long
    With Worksheets("Аналитика по ИБ(1)")
        arr = .Range("C4:C" & .Cells(Rows.Count, "C").End(xlUp).Row - 1).Value
    End With
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then arr(i, 1) = Split(arr(i, 1))(2)
    Next
    Worksheets("Лист1").Range("A1").Resize(UBound(arr), 1) = arr
End Sub
1
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 17:27  [ТС] 16
если точнее то нужно с Аналитика по ИБ(1) B1 - вставить в Лист1 в ячеки A1:..

Добавлено через 5 часов 21 минуту
Окончательная строка получилась

Visual Basic
1
2
3
4
5
6
7
With Worksheets("Аналитика по ИБ(1)")
        arr = .Range("C4:B" & .Cells(Rows.Count, "C").End(xlUp).Row).Value
    End With
    For i = 1 To UBound(arr)
        If arr(i, 1) <> "" Then arr(i, 1) = Split(arr(i, 1))(2)
    Next
    Worksheets("Лист1").Range("A4").Resize(UBound(arr), 1) = arr
Добавлено через 5 минут
МВТ скажите, когда я убераю With Worksheets("Аналитика по ИБ(1)") выдает ошибку, вдруг имя буде другое
0
МВТ
45 / 45 / 15
Регистрация: 14.04.2016
Сообщений: 128
28.05.2016, 17:50 17
dmr12345, тогда просто замените имя листа в этой конструкции
0
dmr12345
0 / 0 / 0
Регистрация: 15.03.2016
Сообщений: 105
28.05.2016, 17:53  [ТС] 18
понятно

Добавлено через 1 минуту
как вы думаете For i = 4 To 65536 65536 лучше убрать и сделать до последней строки
0
28.05.2016, 17:53
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.