Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Распределение массива в три ячейки - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Распределение массива в три ячейки (Макросы/Sub)
Распределение массива в три ячейки
ZamoK Дата: Понедельник, 18.04.2016, 15:38 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Доброго дня!
уважаемые форумчане! Возникла необходимость собрать массив и равномерно распределить в ТРИ строки. Как собрать в одну строку через пробелы и запятую знаю, а вот в три и равномерно никак не соображу. За любую помощь буду признателен.
К сообщению приложен файл: 8650304.xls (31.0 Kb)


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеДоброго дня!
уважаемые форумчане! Возникла необходимость собрать массив и равномерно распределить в ТРИ строки. Как собрать в одну строку через пробелы и запятую знаю, а вот в три и равномерно никак не соображу. За любую помощь буду признателен.

Автор - ZamoK
Дата добавления - 18.04.2016 в 15:38
Roman777 Дата: Понедельник, 18.04.2016, 15:53 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
ZamoK, а если общее кол-во не делится на 3? приоритет 1я из трёх строк? и порядок расброса не важен? можно 1-в 1-ю, 2- во 2-ю, 3-ю в 3-ю строчку. А можно 1,2,3 в 1-ю строчку, далее 4,5,6 во 2-ю, 7,8,9,10 в 3-ю...


Много чего не знаю!!!!
 
Ответить
СообщениеZamoK, а если общее кол-во не делится на 3? приоритет 1я из трёх строк? и порядок расброса не важен? можно 1-в 1-ю, 2- во 2-ю, 3-ю в 3-ю строчку. А можно 1,2,3 в 1-ю строчку, далее 4,5,6 во 2-ю, 7,8,9,10 в 3-ю...

Автор - Roman777
Дата добавления - 18.04.2016 в 15:53
ZamoK Дата: Понедельник, 18.04.2016, 15:57 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Roman777, Я тоже думал над этим но у меня со счётчиком проблема, думал посчитать запятые разделить на 3 и вставить


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеRoman777, Я тоже думал над этим но у меня со счётчиком проблема, думал посчитать запятые разделить на 3 и вставить

Автор - ZamoK
Дата добавления - 18.04.2016 в 15:57
ZamoK Дата: Понедельник, 18.04.2016, 16:00 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
А можно ли посчитать кол-во знаков, затем делить на 3 и брать массив до первой запятой?


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеА можно ли посчитать кол-во знаков, затем делить на 3 и брать массив до первой запятой?

Автор - ZamoK
Дата добавления - 18.04.2016 в 16:00
doober Дата: Понедельник, 18.04.2016, 16:23 | Сообщение № 5
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Вот что записал у меня макрорекодер[vba]
Код
Sub Макрос1()
    Dim s As String, Count As Integer
    dx = Range("C4:E52")
    For n = 1 To UBound(dx)
        If dx(n, 1) <> "" Then
            s = s & "|" & dx(n, 2) & " " & dx(n, 1) & " - " & dx(n, 3)
        End If
    Next
    Z = Split(s, "|")
    Count = UBound(Z) / 3
    ReDim X(1 To 3, 1 To 1)
    For n = 1 To UBound(Z)
        Select Case n
        Case Is <= Count
            X(1, 1) = X(1, 1) & "," & Z(n)
        Case Count + 1 To 2 * Count
            X(2, 1) = X(2, 1) & "," & Z(n)
        Case Else
            X(3, 1) = X(3, 1) & "," & Z(n)
        End Select

    Next
    X(1, 1) = Mid(X(1, 1), 2, Len(X(1, 1)) - 1)
    X(2, 1) = Mid(X(2, 1), 2, Len(X(2, 1)) - 1)
    X(3, 1) = Mid(X(3, 1), 2, Len(X(3, 1)) - 1)
    Range("I5").Resize(3, 1) = X

End Sub
[/vba]


 
Ответить
СообщениеВот что записал у меня макрорекодер[vba]
Код
Sub Макрос1()
    Dim s As String, Count As Integer
    dx = Range("C4:E52")
    For n = 1 To UBound(dx)
        If dx(n, 1) <> "" Then
            s = s & "|" & dx(n, 2) & " " & dx(n, 1) & " - " & dx(n, 3)
        End If
    Next
    Z = Split(s, "|")
    Count = UBound(Z) / 3
    ReDim X(1 To 3, 1 To 1)
    For n = 1 To UBound(Z)
        Select Case n
        Case Is <= Count
            X(1, 1) = X(1, 1) & "," & Z(n)
        Case Count + 1 To 2 * Count
            X(2, 1) = X(2, 1) & "," & Z(n)
        Case Else
            X(3, 1) = X(3, 1) & "," & Z(n)
        End Select

    Next
    X(1, 1) = Mid(X(1, 1), 2, Len(X(1, 1)) - 1)
    X(2, 1) = Mid(X(2, 1), 2, Len(X(2, 1)) - 1)
    X(3, 1) = Mid(X(3, 1), 2, Len(X(3, 1)) - 1)
    Range("I5").Resize(3, 1) = X

End Sub
[/vba]

Автор - doober
Дата добавления - 18.04.2016 в 16:23
ZamoK Дата: Понедельник, 18.04.2016, 16:29 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
doober, Хорошо но слишком много, текст надо собрать до первой пустой строки, т.е. номер узла слева в таблице, и собирать надо только его составляющие, (справа которые) до первого пробела и эти делали уложить в три строки


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениеdoober, Хорошо но слишком много, текст надо собрать до первой пустой строки, т.е. номер узла слева в таблице, и собирать надо только его составляющие, (справа которые) до первого пробела и эти делали уложить в три строки

Автор - ZamoK
Дата добавления - 18.04.2016 в 16:29
doober Дата: Понедельник, 18.04.2016, 16:30 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Принцип понятен,допиливайте под себя


 
Ответить
СообщениеПринцип понятен,допиливайте под себя

Автор - doober
Дата добавления - 18.04.2016 в 16:30
ZamoK Дата: Понедельник, 18.04.2016, 16:34 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
doober, Спасибо Буду пилить hands


Я не Гуру, но стремлюсь!
 
Ответить
Сообщениеdoober, Спасибо Буду пилить hands

Автор - ZamoK
Дата добавления - 18.04.2016 в 16:34
SLAVICK Дата: Понедельник, 18.04.2016, 17:11 | Сообщение № 9
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Сделал UDF кой:
[vba]
Код
Function co(s As String, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
Set r = Columns("a:a").Find(What:=s, After:=Cells(1, 1), LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

Do Until Len(r.Offset(i, 2)) = 0
    ReDim Preserve mF(i)
    mF(i) = r.Offset(i, 3) & " " & r.Offset(i, 2) & " " & r.Offset(i, 4) & " шт."
    i = i + 1
Loop
i = i - 1

If n = 1 Then st = 0 Else st = Int(i / nDel * (n - 1)) + 1
If n = nDel Then f = i Else f = Int(i / nDel * (n))

For i = st To f - 1
    co = co & mF(i) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]
Разделитель потом поставите какой нужно - вместо vbLf . Просто так нагляднее.
С такой UDF - можете делить на 3и, 4е ... кусков. :D
Формула "заточена" под пример.
К сообщению приложен файл: 1546210.xls (54.5 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеСделал UDF кой:
[vba]
Код
Function co(s As String, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
Set r = Columns("a:a").Find(What:=s, After:=Cells(1, 1), LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

Do Until Len(r.Offset(i, 2)) = 0
    ReDim Preserve mF(i)
    mF(i) = r.Offset(i, 3) & " " & r.Offset(i, 2) & " " & r.Offset(i, 4) & " шт."
    i = i + 1
Loop
i = i - 1

If n = 1 Then st = 0 Else st = Int(i / nDel * (n - 1)) + 1
If n = nDel Then f = i Else f = Int(i / nDel * (n))

For i = st To f - 1
    co = co & mF(i) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]
Разделитель потом поставите какой нужно - вместо vbLf . Просто так нагляднее.
С такой UDF - можете делить на 3и, 4е ... кусков. :D
Формула "заточена" под пример.

Автор - SLAVICK
Дата добавления - 18.04.2016 в 17:11
ZamoK Дата: Вторник, 19.04.2016, 08:41 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
SLAVICK, в очередной раз спасибо, очень круто и огромный выбор представления СУПЕР! first


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеSLAVICK, в очередной раз спасибо, очень круто и огромный выбор представления СУПЕР! first

Автор - ZamoK
Дата добавления - 19.04.2016 в 08:41
ZamoK Дата: Вторник, 19.04.2016, 09:57 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
SLAVICK, а если перенести исходные данные или результат на другой лист?


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеSLAVICK, а если перенести исходные данные или результат на другой лист?

Автор - ZamoK
Дата добавления - 19.04.2016 в 09:57
ZamoK Дата: Вторник, 19.04.2016, 10:29 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Все ответ нашёл
[vba]
Код
Set r = Лист2.Columns("a:a").Find(What:=s, After:=Cells(1, 1), LookIn:=xlFormulas _
[/vba]


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 19.04.2016, 10:30
 
Ответить
СообщениеВсе ответ нашёл
[vba]
Код
Set r = Лист2.Columns("a:a").Find(What:=s, After:=Cells(1, 1), LookIn:=xlFormulas _
[/vba]

Автор - ZamoK
Дата добавления - 19.04.2016 в 10:29
SLAVICK Дата: Вторник, 19.04.2016, 10:41 | Сообщение № 13
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
в очередной раз спасибо

Пожалуйста ;)
а если перенести исходные данные или результат на другой лист?

Формула "заточена" под пример.


Я же уже писал Вам:
А почему сразу не показали оригинал?

Старайтесь сразу делать полные примеры со всеми нюансами.
на другой лист

Вот так будет работать - добавил еще одну переменную.
[vba]
Код
Function co(s As String, rf As Range, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
With rf.Parent
    Set r = rf.Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
    Do Until Len(r.Offset(i, 2)) = 0
        mF(i) = r.Offset(i, 3) & " " & r.Offset(i, 2) & " " & r.Offset(i, 4) & " шт."
        i = i + 1
        ReDim Preserve mF(i)
    Loop
    i = i - 1
End With
If n = 1 Then st = 0 Else st = Int(i / nDel * (n - 1)) + 1
If n = nDel Then f = i Else f = Int(i / nDel * (n))

For i = st To f - 1
    co = co & mF(i) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]
К сообщению приложен файл: 1546210-1-.xls (55.5 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
в очередной раз спасибо

Пожалуйста ;)
а если перенести исходные данные или результат на другой лист?

Формула "заточена" под пример.


Я же уже писал Вам:
А почему сразу не показали оригинал?

Старайтесь сразу делать полные примеры со всеми нюансами.
на другой лист

Вот так будет работать - добавил еще одну переменную.
[vba]
Код
Function co(s As String, rf As Range, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
With rf.Parent
    Set r = rf.Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
    Do Until Len(r.Offset(i, 2)) = 0
        mF(i) = r.Offset(i, 3) & " " & r.Offset(i, 2) & " " & r.Offset(i, 4) & " шт."
        i = i + 1
        ReDim Preserve mF(i)
    Loop
    i = i - 1
End With
If n = 1 Then st = 0 Else st = Int(i / nDel * (n - 1)) + 1
If n = nDel Then f = i Else f = Int(i / nDel * (n))

For i = st To f - 1
    co = co & mF(i) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]

Автор - SLAVICK
Дата добавления - 19.04.2016 в 10:41
ZamoK Дата: Вторник, 19.04.2016, 12:34 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Ещё один маленький вопрос, если состоит из 2 комплектующих, как убрать повторение первой ?
Убрал значение первой ячейки условным форматированием по равенству, но может как-то в коде?
К сообщению приложен файл: 2979731.xls (51.0 Kb)


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Вторник, 19.04.2016, 12:45
 
Ответить
СообщениеЕщё один маленький вопрос, если состоит из 2 комплектующих, как убрать повторение первой ?
Убрал значение первой ячейки условным форматированием по равенству, но может как-то в коде?

Автор - ZamoK
Дата добавления - 19.04.2016 в 12:34
SLAVICK Дата: Вторник, 19.04.2016, 16:14 | Сообщение № 15
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
как убрать повторение первой

так?
[vba]
Код
Function co(s As String, rf As Range, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
With rf.Parent
    Set r = rf.Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
    Do Until Len(r.Offset(I, 2)) = 0
        mF(I) = r.Offset(I, 3) & " " & r.Offset(I, 2) & " " & r.Offset(I, 4) & " øò."
        I = I + 1
        ReDim Preserve mF(I)
    Loop
    I = I - 1
End With

If n > I + 1 Then co = "": Exit Function
If n = 1 Then st = 0 Else st = Int(I / nDel * (n - 1)) + 1
If n = nDel Or n > I Then f = I Else f = Int(I / nDel * (n))

For I = st To f - 1
    co = co & mF(I) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]
К сообщению приложен файл: 2701011.xls (53.0 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
как убрать повторение первой

так?
[vba]
Код
Function co(s As String, rf As Range, n%, Optional nDel% = 3)
Dim r As Range, mF, ii&, st&, f&
ReDim mF(0 To 0)
With rf.Parent
    Set r = rf.Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
    Do Until Len(r.Offset(I, 2)) = 0
        mF(I) = r.Offset(I, 3) & " " & r.Offset(I, 2) & " " & r.Offset(I, 4) & " øò."
        I = I + 1
        ReDim Preserve mF(I)
    Loop
    I = I - 1
End With

If n > I + 1 Then co = "": Exit Function
If n = 1 Then st = 0 Else st = Int(I / nDel * (n - 1)) + 1
If n = nDel Or n > I Then f = I Else f = Int(I / nDel * (n))

For I = st To f - 1
    co = co & mF(I) & vbLf '", "
Next
co = co & mF(f)
End Function
[/vba]

Автор - SLAVICK
Дата добавления - 19.04.2016 в 16:14
ZamoK Дата: Вторник, 19.04.2016, 16:17 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Спасибо


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеСпасибо

Автор - ZamoK
Дата добавления - 19.04.2016 в 16:17
ZamoK Дата: Четверг, 28.04.2016, 12:25 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Дополнил переменную ( k = [r4]) в кол-во,

как сделать чтоб функция срабатывала при изменении переменной?


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Четверг, 28.04.2016, 12:26
 
Ответить
СообщениеДополнил переменную ( k = [r4]) в кол-во,

как сделать чтоб функция срабатывала при изменении переменной?

Автор - ZamoK
Дата добавления - 28.04.2016 в 12:25
ZamoK Дата: Пятница, 29.04.2016, 15:23 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
По всей видимости, сие волшебство не возможно?
Почему-то не верю я, что excel это не под силу? Кнопкой реализовал через "грязные ячейки", а вот тут как ?
[moder]Что Вы хотите сделать?
Где пример с пояснениями?[/moder]


Я не Гуру, но стремлюсь!

Сообщение отредактировал SLAVICK - Пятница, 29.04.2016, 16:51
 
Ответить
СообщениеПо всей видимости, сие волшебство не возможно?
Почему-то не верю я, что excel это не под силу? Кнопкой реализовал через "грязные ячейки", а вот тут как ?
[moder]Что Вы хотите сделать?
Где пример с пояснениями?[/moder]

Автор - ZamoK
Дата добавления - 29.04.2016 в 15:23
ZamoK Дата: Вторник, 10.05.2016, 08:30 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 268
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Все работает исправно, но хотелось бы чтоб функция срабатывала при изменении не только номера, но и кол-ва.
К сообщению приложен файл: 2701011-1-.xls (51.5 Kb)


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеВсе работает исправно, но хотелось бы чтоб функция срабатывала при изменении не только номера, но и кол-ва.

Автор - ZamoK
Дата добавления - 10.05.2016 в 08:30
SLAVICK Дата: Вторник, 10.05.2016, 09:22 | Сообщение № 20
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
хотелось бы чтоб функция срабатывала при изменении не только номера, но и кол-ва

Так она и срабатывает, просто у меня в примере - в формуле я написал:
Код
=co($A$1;Лист2!A:A;СТРОКА(K1);4)

Напишите:
Код
=co($A$1;Лист2!A:A;СТРОКА(K1);$C$1)
К сообщению приложен файл: 2898661-1-.xls (53.0 Kb)


Иногда все проще чем кажется с первого взгляда.

Сообщение отредактировал SLAVICK - Вторник, 10.05.2016, 09:46
 
Ответить
Сообщение
хотелось бы чтоб функция срабатывала при изменении не только номера, но и кол-ва

Так она и срабатывает, просто у меня в примере - в формуле я написал:
Код
=co($A$1;Лист2!A:A;СТРОКА(K1);4)

Напишите:
Код
=co($A$1;Лист2!A:A;СТРОКА(K1);$C$1)

Автор - SLAVICK
Дата добавления - 10.05.2016 в 09:22
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Распределение массива в три ячейки (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!