Всем доброго времени суток. Нужно сцепить текст с разных листов в ячейку C3 при этом его разместив по возростанию. Текст на всех листах находится в одинаковой ячейке D1 (текст это номера нарядов), разделить их нужно через ", " Имена листов c которых нужно собирать указываются в столбце A c 2 по 20 строки.
Всем доброго времени суток. Нужно сцепить текст с разных листов в ячейку C3 при этом его разместив по возростанию. Текст на всех листах находится в одинаковой ячейке D1 (текст это номера нарядов), разделить их нужно через ", " Имена листов c которых нужно собирать указываются в столбце A c 2 по 20 строки.Arc1104
независимо от очерёдности листов или цифр на листах то так можно:
[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]
Код
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
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]
Можно так тогда попробовать: [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
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]
Все хорошо, но если листы расположены не в начале книги и не по очереди, то не работает.
[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
Сообщение отредактировал Arc1104 - Суббота, 05.12.2015, 23:09
[/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]
Arc1104, вся проблема заключалась не в последовательности листов, а в том что названия - числа. строка для имени [vba]
[/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