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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных по условию (Макросы/Sub)
Перенос данных по условию
AVI Дата: Понедельник, 04.02.2019, 10:02 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 523
Репутация: 17 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Как дополнить код так, что бы в случае если в столбце 4 таблицы находится плюс, то к найденному через пробел добавлялось содержимое столбца 5, а если минус, то шестого.
К сообщению приложен файл: _Microsoft_Exce.xlsm (47.6 Kb)
 
Ответить
СообщениеДобрый день!
Как дополнить код так, что бы в случае если в столбце 4 таблицы находится плюс, то к найденному через пробел добавлялось содержимое столбца 5, а если минус, то шестого.
Автор - AVI
Дата добавления - 04.02.2019 в 10:02
Glen Дата: Понедельник, 04.02.2019, 10:53 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 94
Репутация: 10 ±
Замечаний: 0% ±

Excel 2010-16
Так?
К сообщению приложен файл: 7850835.xlsm (54.3 Kb)

Пехаль киндриков куравь, пехаль киндриков лузнись.
 
Ответить
СообщениеТак?
Автор - Glen
Дата добавления - 04.02.2019 в 10:53
AVI Дата: Вторник, 05.02.2019, 04:10 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 523
Репутация: 17 ±
Замечаний: 0% ±

Excel 2016
Glen, Да, Спасибо)
Я тут как всегда все сломал.
Пытаюсь экспериментировать, но выдается type mismatch
Почему?
К сообщению приложен файл: 1406634.xlsm (69.4 Kb)
 
Ответить
СообщениеGlen, Да, Спасибо)
Я тут как всегда все сломал.
Пытаюсь экспериментировать, но выдается type mismatch
Почему?
Автор - AVI
Дата добавления - 05.02.2019 в 04:10
Glen Дата: Вторник, 05.02.2019, 06:17 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 94
Репутация: 10 ±
Замечаний: 0% ±

Excel 2010-16
.
К сообщению приложен файл: 0870048.xlsm (74.6 Kb)

Пехаль киндриков куравь, пехаль киндриков лузнись.
 
Ответить
Сообщение.
Автор - Glen
Дата добавления - 05.02.2019 в 06:17
Glen Дата: Вторник, 05.02.2019, 06:23 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 94
Репутация: 10 ±
Замечаний: 0% ±

Excel 2010-16
ИГДП № 2?

Пехаль киндриков куравь, пехаль киндриков лузнись.
 
Ответить
СообщениеИГДП № 2?
Автор - Glen
Дата добавления - 05.02.2019 в 06:23
_Boroda_ Дата: Вторник, 05.02.2019, 09:23 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
У меня такой вариант по первому файлу
[vba]
Код
ar1(n1_, 1) = ar0(i, 3) & ", " & Format(ar0(i, 6 + (ar0(i, 4) = "-")), "0.0")
[/vba]
Целиком код с парой комментариев (это вроде я писал когда-то где-то, да?)
[vba]
Код
Sub qqq()
    Dim ar0, n0_, r0_, r1_, ar1, i, n1, n1_, z_
    ar0 = Range("Расчет")
    n0_ = UBound(ar0)
    With Worksheets("Лист1")
        z_ = .Range("D2").Value
        r0_ = 6
        r1_ = .Cells(Rows.Count, 4).End(3).Row
        If r1_ >= r0_ Then
            .Cells(r0_, 4).Resize(r1_ - r0_ + 1, 10).ClearContents
        End If
        ar1 = .Cells(r0_, 4).Resize(n0_) 'зачем 10 столбцов было?
        For i = 1 To n0_
            If ar0(i, 2) = z_ Then 'не нужно каждый раз обращаться к ячейке, вынес в переменную z_
                n1_ = n1_ + 1
                ar1(n1_, 1) = ar0(i, 3) & ", " & Format(ar0(i, 6 + (ar0(i, 4) = "-")), "0.0")
            End If
        Next i
        .Cells(r0_, 4).Resize(n1_) = ar1
    End With
End Sub
[/vba]
К сообщению приложен файл: 5635627.xlsm (48.1 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ меня такой вариант по первому файлу
[vba]
Код
ar1(n1_, 1) = ar0(i, 3) & ", " & Format(ar0(i, 6 + (ar0(i, 4) = "-")), "0.0")
[/vba]
Целиком код с парой комментариев (это вроде я писал когда-то где-то, да?)
[vba]
Код
Sub qqq()
    Dim ar0, n0_, r0_, r1_, ar1, i, n1, n1_, z_
    ar0 = Range("Расчет")
    n0_ = UBound(ar0)
    With Worksheets("Лист1")
        z_ = .Range("D2").Value
        r0_ = 6
        r1_ = .Cells(Rows.Count, 4).End(3).Row
        If r1_ >= r0_ Then
            .Cells(r0_, 4).Resize(r1_ - r0_ + 1, 10).ClearContents
        End If
        ar1 = .Cells(r0_, 4).Resize(n0_) 'зачем 10 столбцов было?
        For i = 1 To n0_
            If ar0(i, 2) = z_ Then 'не нужно каждый раз обращаться к ячейке, вынес в переменную z_
                n1_ = n1_ + 1
                ar1(n1_, 1) = ar0(i, 3) & ", " & Format(ar0(i, 6 + (ar0(i, 4) = "-")), "0.0")
            End If
        Next i
        .Cells(r0_, 4).Resize(n1_) = ar1
    End With
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 05.02.2019 в 09:23
AVI Дата: Вторник, 05.02.2019, 09:53 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 523
Репутация: 17 ±
Замечаний: 0% ±

Excel 2016
Цитата _Boroda_, 05.02.2019 в 09:23, в сообщении № 6 ()
это вроде я писал когда-то где-то, да?

Конечно) Почти все красивое у меня только от Вас))
 
Ответить
Сообщение
Цитата _Boroda_, 05.02.2019 в 09:23, в сообщении № 6 ()
это вроде я писал когда-то где-то, да?

Конечно) Почти все красивое у меня только от Вас))
Автор - AVI
Дата добавления - 05.02.2019 в 09:53
_Boroda_ Дата: Вторник, 05.02.2019, 09:59 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16718
Репутация: 6505 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Да ладно! Тут и без меня немерено красоты на форуме
Второй файл
[vba]
Код
Sub qqq()
    ar0 = Range("Расчет")
    n0_ = UBound(ar0)
    With Worksheets("Лист1")
        z1_ = .Range("E2").Value
        z2_ = CDate(.Range("F2").Value)
        z3_ = CDate(.Range("G2").Value)
        r0_ = 6
        r1_ = .Cells(Rows.Count, 4).End(3).Row
        If r1_ >= r0_ Then
            .Cells(r0_, 4).Resize(r1_ - r0_ + 1, 10).ClearContents
        End If
        ar1 = .Cells(r0_, 4).Resize(n0_)
        For i = 1 To n0_
            If ar0(i, 16) = z1_ Then
                If ar0(i, 1) >= z2_ Then
                    If ar0(i, 1) <= z3_ Then
                        If ar0(i, 12) > 0 Then
                            x_ = ""
                            If ar0(i, 25) = "Платные" Then
                    x_ = ", " & ar0(i, 6)
                            End If
                            n1_ = n1_ + 1
                            ar1(n1_, 1) = ar0(i, 3) & x_
                        End If
                    End If
                End If
            End If
        Next i
        .Cells(r0_, 4).Resize(n1_) = ar1
    End With
End Sub

[/vba]
К сообщению приложен файл: 1406634_1.xlsm (71.2 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДа ладно! Тут и без меня немерено красоты на форуме
Второй файл
[vba]
Код
Sub qqq()
    ar0 = Range("Расчет")
    n0_ = UBound(ar0)
    With Worksheets("Лист1")
        z1_ = .Range("E2").Value
        z2_ = CDate(.Range("F2").Value)
        z3_ = CDate(.Range("G2").Value)
        r0_ = 6
        r1_ = .Cells(Rows.Count, 4).End(3).Row
        If r1_ >= r0_ Then
            .Cells(r0_, 4).Resize(r1_ - r0_ + 1, 10).ClearContents
        End If
        ar1 = .Cells(r0_, 4).Resize(n0_)
        For i = 1 To n0_
            If ar0(i, 16) = z1_ Then
                If ar0(i, 1) >= z2_ Then
                    If ar0(i, 1) <= z3_ Then
                        If ar0(i, 12) > 0 Then
                            x_ = ""
                            If ar0(i, 25) = "Платные" Then
                    x_ = ", " & ar0(i, 6)
                            End If
                            n1_ = n1_ + 1
                            ar1(n1_, 1) = ar0(i, 3) & x_
                        End If
                    End If
                End If
            End If
        Next i
        .Cells(r0_, 4).Resize(n1_) = ar1
    End With
End Sub

[/vba]
Автор - _Boroda_
Дата добавления - 05.02.2019 в 09:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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