Сцепить текст с разных листов

Дата: Суббота, 05.12.2015, 11:26 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Всем доброго времени суток. Нужно сцепить текст с разных листов в ячейку C3 при этом его разместив по возростанию. Текст на всех листах находится в одинаковой ячейке D1 (текст это номера нарядов), разделить их нужно через ", " Имена листов c которых нужно собирать указываются в столбце A c 2 по 20 строки.

К сообщению приложен файл: 7832761.xlsx (11.6 Kb)

Сообщение отредактировал Arc1104 - Суббота, 05.12.2015, 11:27

Wasilich

Дата: Суббота, 05.12.2015, 12:11 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Так, вроде бы.
[vba]

Код

Sub www()
  Dim  i&
  For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
     Range("C3") = Range("C3") & Sheets(Cells(i, 1)).Range("D1") & ", "
  Next
End Sub

[/vba]

Сообщение отредактировал Wasilic - Суббота, 05.12.2015, 12:11

Wasilich

Дата: Суббота, 05.12.2015, 12:54 | Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

Репутация: 326 ±

Замечаний: 0% ±

2003

Цитата Arc1104, 05.12.2015 в 12:45, в сообщении № 4

после последнего не должно быть ","

Сильно мешает?

После Next
[vba]

Код

Range("C3") = Left(Range("C3"), Len(Trim(Range("C3"))) - 1)

[/vba]

Дата: Суббота, 05.12.2015, 12:56 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Arc1104, если будет нужно именно

Цитата Arc1104, 05.12.2015 в 11:26, в сообщении № 1

по возростанию

независимо от очерёдности листов или цифр на листах
то так можно:

[vba]

Код

Sub сцепка()
Dim i As Long
Dim s() As String, B As String
Dim i_n As Long
i_n = Worksheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row
ReDim s(i_n - 1)
For i = 2 To i_n
  s(i - 1) = Worksheets(Worksheets("Итог").Cells(i, 1)).Cells(1, 4)
Next i
For i = 1 To i_n - 2
  If CInt(s(i)) > CInt(s(i + 1)) Then
     B = s(i)
     s(i) = s(i + 1)
     s(i + 1) = B
     B = ""
     i = 0
  End If
Next i
For i = 1 To i_n - 1
  If B = "" Then
     B = s(i)
  Else
     B = B & ", " & s(i)
  End If
Next i
Worksheets("Итог").Cells(3, 3) = B
End Sub

[/vba]

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Суббота, 05.12.2015, 12:57

Дата: Суббота, 05.12.2015, 13:25 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Roman777,
Почти то, что нужно.

Здесь мы проматриваем столбец "А" до последнего внесённого значения

Цитата

i_n = Worksheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row

а, если есть пустые ячейки. т.е. имена листов внесены в А3 и А5, а А4 пустая

Дата: Суббота, 05.12.2015, 15:26 | Сообщение № 6

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Можно так тогда попробовать:
[vba]

Код

Sub сцепка2()
Dim s() As Long, B As String
Dim i_n As Long
i_n = Worksheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row
ReDim s(i_n - 1)
For i = 2 To i_n
  If Worksheets("Итог").Cells(i, 1) <> "" Then
     s(i - 1) = Worksheets(Worksheets("Итог").Cells(i, 1)).Cells(1, 4)
  End If
Next i
For i = 1 To i_n - 2
  If s(i) > s(i + 1) Then
    B = s(i)
    s(i) = s(i + 1)
    s(i + 1) = B
    B = ""
    i = 0
  End If
Next i
For i = 1 To i_n - 1
If s(i) <> 0 Then
  If B = "" Then
      B = s(i)
  Else
      B = B & ", " & s(i)
  End If
End If
Next i
Worksheets("Итог").Cells(3, 3) = B
End Sub

[/vba]

Много чего не знаю!!!!

Дата: Суббота, 05.12.2015, 16:32 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Roman777,
Спасибо

Дата: Суббота, 05.12.2015, 22:53 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

[vba]

Код

Dim s() As Long, B As String
Dim i_n As Long
i_n = Worksheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row
ReDim s(i_n - 1)
For i = 2 To i_n
If Worksheets("Итог").Cells(i, 1) <> "" Then
s(i - 1) = Worksheets(Worksheets("Итог").Cells(i, 1)).Cells(1, 4)
End If
Next i
For i = 1 To i_n - 2
If s(i) > s(i + 1) Then
B = s(i)
s(i) = s(i + 1)
s(i + 1) = B
B = ""
i = 0
End If
Next i
For i = 1 To i_n - 1
If s(i) <> 0 Then
If B = "" Then
B = s(i)
Else
B = B & ", " & s(i)
End If
End If
Next i
Worksheets("Итог").Cells(3, 3) = B
End Sub

[/vba]

Все хорошо, но если листы расположены не в начале книги и не по очереди, то не работает.

Сообщение отредактировал Arc1104 - Суббота, 05.12.2015, 23:09

Дата: Суббота, 05.12.2015, 23:52 | Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Arc1104, не может быть связи работы с положением листов) пример покажите, пожалуйста).

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Суббота, 05.12.2015, 23:52

Дата: Воскресенье, 06.12.2015, 00:08 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Цитата Roman777, 05.12.2015 в 23:52, в сообщении № 11

не может быть связи работы с положением листов) пример покажите, пожалуйста).

Он работает не по имени листа а по порядковому номеру этого листа в книге т.е. В столбец "А" нужно вводить не имя а порядковый номер листа.

К сообщению приложен файл: 5032227.xlsm (22.0 Kb)

Сообщение отредактировал Arc1104 - Воскресенье, 06.12.2015, 00:21

Дата: Воскресенье, 06.12.2015, 00:19 | Сообщение № 11

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

Arc1104, вся проблема заключалась не в последовательности листов, а в том что названия - числа.
строка для имени [vba]

Код

Worksheets((Worksheets("Итог").Cells(i, 1))).Cells(1, 4)

[/vba] листа "11" понимается как [vba]

Код

Worksheets(11).Cells(1,4)

[/vba], поэтому ВБА сразу думает что это индекс 11, а не имя, исправить можно как минимум 2-мя способами, которые я знаю:
1) записать эти именно в переменную типа String
2) или сразу преобразовывать в строку выражение (с пом-ю ф-ии CStr):
[vba]

Код

Sub сцепка2()
Dim s() As Long, B As String
Dim i_n As Long
i_n = Worksheets("Итог").Cells(Rows.Count, 1).End(xlUp).Row
ReDim s(i_n - 1)
For i = 2 To i_n
If Worksheets("Итог").Cells(i, 1) <> "" Then
    s(i - 1) = Worksheets(CStr(Worksheets("Итог").Cells(i, 1))).Cells(1, 4)
End If
Next i
For i = 1 To i_n - 2
If s(i) > s(i + 1) Then
    B = s(i)
    s(i) = s(i + 1)
    s(i + 1) = B
    B = ""
    i = 0
End If
Next i
For i = 1 To i_n - 1
If s(i) <> 0 Then
If B = "" Then
    B = s(i)
Else
    B = B & ", " & s(i)
End If
End If
Next i
Worksheets("Итог").Cells(3, 3) = B
End Sub

[/vba]

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Воскресенье, 06.12.2015, 00:20

Дата: Воскресенье, 06.12.2015, 00:26 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 12

Репутация: 0 ±

Замечаний: 20% ±

Excel 2013

Roman777,
Просто супер. Спасибо