Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
mfamgn
0 / 0 / 0
Регистрация: 27.05.2016
Сообщений: 5
1

Разделить данные в нескольких ячейках на строки

27.05.2016, 12:10. Просмотров 931. Ответов 7
Метки нет (Все метки)

Добрый день!
Пожалуйста помогите, решить следующую проблему:
Есть таблица с данными, в которой в 2-х ячейках есть данные разделенные с помощью ;"
Необходимо выделить данные из ячеек в строки ниже с копированием информации из других ячеек

Например:
[Номер][Строка][Персона1;Персона2;Персона3][Документ1;Документ2;Документ3]
нужно привести к следующему виду:
[Номер][Строка][Персона1][Документ1]
[Номер][Строка][Персона2][Документ2]
[Номер][Строка][Персона3][Документ3]

Пример в прикрепленном файле (извините за неудобный вид, пришлось скрыть личные данные), отвечу на любые вопросы.

Буду очень благодарен за помощь.
0
Вложения
Тип файла: xls primer.xls (22.0 Кб, 11 просмотров)
Лучшие ответы (1)
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
27.05.2016, 12:10
Ответы с готовыми решениями:

Разделить данные в ячейках
Здравствуйте, у меня есть список из 1000 почтовых адресов, выгрузка в excel не всегда корректна....

Разделить данные из столбцов в строки
Здравствуйте. Есть xml файл поставщика, в нем данные для каждого товара заданы таким способом. ...

Разделить каждый элемент строки разделить на сумму элементов этой строки
Задан двухмерный массив вещественных чисел А(n,m). Необходимо каждый элемент соответствующей строки...

В нескольких ячейках таблицы Word поставить прочерк во всю длинну
Есть таблица в word. В нескольких ячейках надо поставить прочерк во всю длинну, как такое сделать...

Вывод информации при проверке идентичности значений в нескольких ячейках/столбцах
Здравствуйте, Подскажите как правильно написать формулу по сабжу. На 2 листе есть база с...

7
Alex77755
10993 / 3449 / 593
Регистрация: 13.02.2009
Сообщений: 10,245
28.05.2016, 12:18 2
Макросом можно.
Но непонятно объяснение.
Надо на одном листе как было, а на втором как надо
1
mfamgn
0 / 0 / 0
Регистрация: 27.05.2016
Сообщений: 5
28.05.2016, 16:19  [ТС] 3
Сделал новый пример.
Не знаю как лучше объяснить.
0
Вложения
Тип файла: xls primer.xls (25.0 Кб, 5 просмотров)
mfamgn
0 / 0 / 0
Регистрация: 27.05.2016
Сообщений: 5
28.05.2016, 16:31  [ТС] 4
Есть два столбца в ячейках которых содержатся строки (от 1 до 10), разделенные с помощью ";".
Например:
[Персона1;Персона2;Персона3][Документ1;Документ2;Документ3]
[Персона4][Документ4]
[Персона5;Персона6][Документ5;Документ6]
[Персона7][Документ7]
[Персона8;Персона9;Персона10;Персона11][Документ8;Документ9;Документ10;Документ11]
Нужно чтобы после обработки макросом это выглядело вот так:
[Персона1][Документ1]
[Персона2][Документ2]
[Персона3][Документ3]
[Персона4][Документ4]
[Персона5][Документ5]
[Персона6][Документ6]
[Персона7][Документ7]
[Персона8][Документ8]
[Персона9][Документ9]
[Персона10][Документ10]
[Персона11][Документ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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub NoSpaceAndItem(CheckArray As Variant, Simbol As String)
  Dim TempArray(), j As Integer, i As Integer
   ReDim TempArray(1 To UBound(CheckArray))
   i = 1
   For j = 1 To UBound(CheckArray)
     If CheckArray(j) <> "" Then
       TempArray(i) = CheckArray(j)
       i = i + 1
     End If
   Next j
 
 
End Sub
 
Public ValArray As New Collection
Public Sub RemoveValAndDup(Diapazone As Variant, Sort As Boolean, RemoveItem As String)
    Dim AllCells As Range, Cell As Range
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item
    Set AllCells = Diapazone 'передача массива
    On Error Resume Next
    For Each Cell In AllCells.Cells
      If Cell.Value <> RemoveItem And Cell.Value <> "" Then
        ValArray.Add Cell.Text, CStr(Cell.Text)   'Note: the 2nd argument (key) for the Add method must be a string
      End If
    Next Cell
                  '   Сортировка (optional)
   If Sort = True Then
    For i = 1 To ValArray.Count - 1
        For j = i + 1 To ValArray.Count
            If ValArray(i) > ValArray(j) Then
                Swap1 = ValArray(i)
                Swap2 = ValArray(j)
                ValArray.Add Swap1, before:=j
                ValArray.Add Swap2, before:=i
                ValArray.Remove i + 1
                ValArray.Remove j + 1
            End If
        Next j
    Next i
   End If
End Sub
Public Function CountSimbol(Expression As String, FindSimbol As String) As Integer
 ' функция подсчета количества символов в строке
  CountSimbol = Len(Expression) - Len(Replace(Expression, FindSimbol, ""))
End Function
Function Substring(Txt As String, Delimiter As String, n As Integer) As String
  ' функция разбиения строк на отдельные слова
   Dim x As Variant
      x = Split(Txt, Delimiter)
      If n > 0 And n - 1 <= UBound(x) Then
        Substring = x(n - 1)
      Else
        Substring = ""
      End If
End Function
Sub замена2()
    Application.ScreenUpdating = False: ActiveSheet.UsedRange.Replace What:=" ", Replacement:=""
End Sub
0
Alex77755
10993 / 3449 / 593
Регистрация: 13.02.2009
Сообщений: 10,245
28.05.2016, 17:07 5
Опять не всё понятно:
[Персона1;Персона2;Персона3][Документ1;Документ2;Документ3]
Количество персонала всегда соответствует количеству документов?
И второе: колонки в которых разделённые строки фиксированы? их можно задавать фиксировано?
1
mfamgn
0 / 0 / 0
Регистрация: 27.05.2016
Сообщений: 5
28.05.2016, 17:25  [ТС] 6
Да, количество персонала всегда равно количеству документов (если нет, то это ошибка и нужно её как-то отметить).
Колонки не фиксированы, но можно задать их фиксировано как G и H, если так удобнее написать макрос.
0
Alex77755
10993 / 3449 / 593
Регистрация: 13.02.2009
Сообщений: 10,245
28.05.2016, 17:57 7
Лучший ответ Сообщение было отмечено mfamgn как решение

Решение

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
Option Explicit
 
Sub qwert()
Dim r!, c!, m(), lr!, lc!, rn!, c1!, c2!, rz(), ri!, u1, u2, ii
c1 = 7 '
c2 = 8 '
With Лист1
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
    m = .[a1].Resize(lr, lc).Value
    For r = 1 To UBound(m): lr = lr + UBound(Split(m(r, c1), ";")): Next
    ReDim rz(1 To lr, 1 To lr)
    For r = 1 To UBound(m)
        If InStr(1, m(r, c1), ";") > 0 Then
            u1 = Split(m(r, c1), ";")
            u2 = Split(m(r, c2), ";")
            If UBound(u1) <> UBound(u2) Then MsgBox "В строке " & r & " несоответсвие", vbCritical, ""
            For ii = 0 To UBound(u1)
                If Len(u1(ii)) > 0 Then
                    ri = ri + 1
                    For c = 1 To lc
                        rz(ri, c) = m(r, c)
                    Next c
                    rz(ri, c1) = u1(ii)
                    rz(ri, c2) = u2(ii)
                End If
            Next ii
        Else
            ri = ri + 1
            For c = 1 To lc
                rz(ri, c) = m(r, c)
            Next c
        End If
    Next r
    .[a1].Resize(lr, lc) = rz
End With
End Sub
1
mfamgn
0 / 0 / 0
Регистрация: 27.05.2016
Сообщений: 5
29.05.2016, 12:39  [ТС] 8
Спасибо. Это решение работает прекрасно. Огромное спасибо еще раз!
0
29.05.2016, 12:39
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
29.05.2016, 12:39

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

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

Одинаковые данные в 2-3 ячейках
Помогите ну совсем чайнику в Excel. Необходимо что бы в двух, трёх ячейка отображались одинаковые...

Сопоставить данные в ячейках
Привет. Приложил файлик. Столбец А разные фразы, столбец B числовое значение. В столбце D те...


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

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Опции темы

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