Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сцепить значения двух столбцов в один
 
#1
17.05.2021 10:12:06
Проблема заключается в том, что при выгрузке из ворд в эксель некоторые столбцы находятся в двух ячейках, а нужны в одной. В исходном файле формата ворд тоже самое, там  всё через перенос строки. Так-как массив таблиц огромный, в ручную не получится сделать.
пример на фото. Посоветуйте пожалуста макрос, или алгоритм действий, спасибо!!!
 
 
 
#2
17.05.2021 10:27:28
Цитата
Ares172 semon написал:
... или алгоритм действий

Я бы делал такой макрос:
1. Находим непустую ячейку в столбце "Номер п/п".
2. Проверяем в столбце "ФИО" ячейку следующей строки, если она не пустая, то цепляем ее к основной ячейке, нижнюю очищаем.
3. Проверяем столбец "Место рождения", если нижняя ячейка не пустая и т.д. по всем столбцам, где может быть разрыв.
 
 
 
#3
17.05.2021 10:28:50
Михаил к большему сожалению навыка написания макросов у меня нет.
 
 
 
#4
17.05.2021 11:19:07
Добрый день!
Вариант Power Query
 
 
 
#5
17.05.2021 11:40:39
Вариант макроса:

Код
Sub Style_r1c1()
    Application.ReferenceStyle = xlR1C1 ' переключение на нумерацию столбцов, если нужно
End Sub


Код
Sub Scepka()
    For i = 3 To 40 'проверяемые строки от 3 до 40
           If ActiveSheet.Cells(i, 1) <> 0 Then
            
            ' Проверка столбца "ФИО"
x = 2 ' номер столбца с разрывами
            
            If ActiveSheet.Cells(i + 1, x) <> "" Then
                ActiveSheet.Cells(i, x) = ActiveSheet.Cells(i, x) + ActiveSheet.Cells(i + 1, x)
                ActiveSheet.Cells(i + 1, x).Clear
            End If
            
            ' Проверка столбца "Место рождения"
x = 4
            
            If ActiveSheet.Cells(i + 1, x) <> "" Then
                ActiveSheet.Cells(i, x) = ActiveSheet.Cells(i, x) + ActiveSheet.Cells(i + 1, x)
                ActiveSheet.Cells(i + 1, x).Clear
            End If

            ' Проверка столбца "Адрес"
x = 8
            
            If ActiveSheet.Cells(i + 1, x) <> "" Then
                ActiveSheet.Cells(i, x) = ActiveSheet.Cells(i, x) + ActiveSheet.Cells(i + 1, x)
                ActiveSheet.Cells(i + 1, x).Clear
            End If
            
            ' Проверка столбца "Паспорт выдан"
x = 11
            
            If ActiveSheet.Cells(i + 1, x) <> "" Then 'проверяем вторую строку
                ActiveSheet.Cells(i, x) = ActiveSheet.Cells(i, x) + ActiveSheet.Cells(i + 1, x)
                ActiveSheet.Cells(i + 1, x).Clear
            End If
            If ActiveSheet.Cells(i + 2, x) <> "" Then ' проверяем третью строку
                ActiveSheet.Cells(i, x) = ActiveSheet.Cells(i, x) + ActiveSheet.Cells(i + 2, x)
                ActiveSheet.Cells(i + 2, x).Clear
            End If
        End If
    Next i
End Sub
Изменено: Михаил - 17.05.2021 11:42:38
 
 
 
#6
17.05.2021 11:45:08
Цитата
Andrey_S написал:
Andrey_S
Пожалуйста подскажите как это сделать?
Распишите если не трудно, алгоритм действий.
 
 
 
#7
17.05.2021 11:59:45
В файле находится запрос Power Query, который обрабатывает предоставленные Вами данные. В нем можете посмотреть, какие он производит действия.
 
 
 
#8
17.05.2021 12:28:46
Цитата
Ares172 semon написал:
В исходном файле формата ворд тоже самое
Все может быть, но скорее нет, чем да.
 
 
 
#9
17.05.2021 13:06:28
Может проще перед выгрузкой в Excel отредактировать данные в Word. Например удалить "Знак абзаца" и только после этого переносить данные
 
 
 
#10
18.05.2021 08:57:39
Цитата
Михаил написал:
Вариант макроса:
Михаил подскажите, пробовали сами переделать макрос, не получилось. Как выполнить тоже самое действие только по всем столбцам, плюс область которая соединяется добавить пробел. А то он склеивает все слитно. Просто в массиве другие столбцы тоже имеют области на две строки, в вышеуказанном примере не сразу видно было.
Изменено: Ares172 - 18.05.2021 09:16:47
 
 
 
#11
18.05.2021 09:02:18
Царь-цитата  8-0
Изменено: Jack Famous - 18.05.2021 09:02:38
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#12
18.05.2021 09:07:29
Ares172, вернитесь, приведите сообщение в порядок
 
 
 
Страницы: 1
Наверх