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

Вход

Регистрация

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

 

= Мир MS Excel/макрос умножения числа с одного столбца на число с другого - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос умножения числа с одного столбца на число с другого (Макросы/Sub)
макрос умножения числа с одного столбца на число с другого
grh1 Дата: Среда, 27.02.2019, 12:04 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Добрый день уважаемые знатоки!
Если не трудно, подскажите код, чтобы можно было:
В файле столбцы синим цветом – это оригинал (очень длинный список из тысяч тысяч строк), а мне нужно чтобы макрос преобразовал эти столбцы и сделал вид как в столбце красным цветом.
То есть с первого (синий) столбца взял число и умножил на число с соседнего столбца, при этом убрал число с первого.

Пример:

100м2---0,385
м----7,4
10м-----8,2

чтобы получилось так:

м2---38,5
м-----7,4
м-----82

Спасибо.
К сообщению приложен файл: 3763513.xls (45.0 Kb)


Vadym Gorokh

Сообщение отредактировал grh1 - Среда, 27.02.2019, 12:10
 
Ответить
СообщениеДобрый день уважаемые знатоки!
Если не трудно, подскажите код, чтобы можно было:
В файле столбцы синим цветом – это оригинал (очень длинный список из тысяч тысяч строк), а мне нужно чтобы макрос преобразовал эти столбцы и сделал вид как в столбце красным цветом.
То есть с первого (синий) столбца взял число и умножил на число с соседнего столбца, при этом убрал число с первого.

Пример:

100м2---0,385
м----7,4
10м-----8,2

чтобы получилось так:

м2---38,5
м-----7,4
м-----82

Спасибо.

Автор - grh1
Дата добавления - 27.02.2019 в 12:04
boa Дата: Среда, 27.02.2019, 13:16 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 549
Репутация: 167 ±
Замечаний: 0% ±

365
[vba]
Код
Sub NewMacros()
    Dim iRow&, LastRow&
    Dim iIndex&, sValue$
    Dim i&
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        For iRow = 5 To LastRow
            iIndex = 0: sValue = VBA.Trim$(.Cells(iRow, 4).Value)
            If Len(VBA.Trim$(.Cells(iRow, 5).Value)) > 0 Then
                For i = 1 To Len(sValue)
                    If IsNumeric(Mid(sValue, i, 1)) And Mid(sValue, i, 1) <> " " Then
                        iIndex = iIndex * 10 + CInt(Mid(sValue, i, 1))
                    Else: Exit For: End If
                Next i
                If iIndex = 0 Then iIndex = 1
                .Cells(iRow, 17) = VBA.Trim$(Replace(sValue, CStr(iIndex), ""))
                .Cells(iRow, 18) = iIndex * .Cells(iRow, 5)
            End If
        Next iRow
    End With
End Sub
[/vba]
К сообщению приложен файл: 6706671.xls (72.0 Kb)




Сообщение отредактировал boa - Среда, 27.02.2019, 13:57
 
Ответить
Сообщение[vba]
Код
Sub NewMacros()
    Dim iRow&, LastRow&
    Dim iIndex&, sValue$
    Dim i&
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        For iRow = 5 To LastRow
            iIndex = 0: sValue = VBA.Trim$(.Cells(iRow, 4).Value)
            If Len(VBA.Trim$(.Cells(iRow, 5).Value)) > 0 Then
                For i = 1 To Len(sValue)
                    If IsNumeric(Mid(sValue, i, 1)) And Mid(sValue, i, 1) <> " " Then
                        iIndex = iIndex * 10 + CInt(Mid(sValue, i, 1))
                    Else: Exit For: End If
                Next i
                If iIndex = 0 Then iIndex = 1
                .Cells(iRow, 17) = VBA.Trim$(Replace(sValue, CStr(iIndex), ""))
                .Cells(iRow, 18) = iIndex * .Cells(iRow, 5)
            End If
        Next iRow
    End With
End Sub
[/vba]

Автор - boa
Дата добавления - 27.02.2019 в 13:16
grh1 Дата: Среда, 27.02.2019, 13:25 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
boa,
скачал Ваш файлик, выдает ошибку.
Может мне надо что-то подправить в коде?


Vadym Gorokh
 
Ответить
Сообщениеboa,
скачал Ваш файлик, выдает ошибку.
Может мне надо что-то подправить в коде?

Автор - grh1
Дата добавления - 27.02.2019 в 13:25
grh1 Дата: Среда, 27.02.2019, 13:32 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019


Vadym Gorokh
 
Ответить
Сообщение

Автор - grh1
Дата добавления - 27.02.2019 в 13:32
_Boroda_ Дата: Среда, 27.02.2019, 13:33 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У меня такой вариант
[vba]
Код
Sub tt()
    c_ = 4
    r0_ = 5
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    If n_ < 1 Then Exit Sub
    ar = Cells(r0_, c_).Resize(n_, 2)
    On Error Resume Next
    For i = 1 To n_
        If IsNumeric(ar(i, 2)) And ar(i, 2) > 0 Then
            ar(i, 1) = Trim(ar(i, 1))
            If CByte(Left(ar(i, 1), 1)) Then
                For j = 1 To Len(ar(i, 1))
                    If Not IsNumeric(Left(ar(i, 1), j)) Then
                        ar(i, 2) = ar(i, 2) * Left(ar(i, 1), j - 1)
                        ar(i, 1) = Mid(ar(i, 1), j)
                        Exit For
                    End If
                Next j
            End If
        End If
    Next i
    Cells(r0_, c_).Resize(n_, 2) = ar
End Sub
[/vba]

*Добавлено
Поменял местами строки
[vba]
Код
ar(i, 2) = ar(i, 2) * Left(ar(i, 1), j - 1)
ar(i, 1) = Mid(ar(i, 1), j)
[/vba]
К сообщению приложен файл: 3763513_2.xls (56.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995


Сообщение отредактировал _Boroda_ - Среда, 27.02.2019, 13:47
 
Ответить
СообщениеУ меня такой вариант
[vba]
Код
Sub tt()
    c_ = 4
    r0_ = 5
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    If n_ < 1 Then Exit Sub
    ar = Cells(r0_, c_).Resize(n_, 2)
    On Error Resume Next
    For i = 1 To n_
        If IsNumeric(ar(i, 2)) And ar(i, 2) > 0 Then
            ar(i, 1) = Trim(ar(i, 1))
            If CByte(Left(ar(i, 1), 1)) Then
                For j = 1 To Len(ar(i, 1))
                    If Not IsNumeric(Left(ar(i, 1), j)) Then
                        ar(i, 2) = ar(i, 2) * Left(ar(i, 1), j - 1)
                        ar(i, 1) = Mid(ar(i, 1), j)
                        Exit For
                    End If
                Next j
            End If
        End If
    Next i
    Cells(r0_, c_).Resize(n_, 2) = ar
End Sub
[/vba]

*Добавлено
Поменял местами строки
[vba]
Код
ar(i, 2) = ar(i, 2) * Left(ar(i, 1), j - 1)
ar(i, 1) = Mid(ar(i, 1), j)
[/vba]

Автор - _Boroda_
Дата добавления - 27.02.2019 в 13:33
grh1 Дата: Среда, 27.02.2019, 13:41 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
_Boroda_,
Ваш вариант хорош, только он убирает цифры в первом столбце, но не умножает на них соседний столбец.

БЫЛО:

100м2----0,3

НАДО:

м2-----30


Vadym Gorokh

Сообщение отредактировал grh1 - Среда, 27.02.2019, 13:43
 
Ответить
Сообщение_Boroda_,
Ваш вариант хорош, только он убирает цифры в первом столбце, но не умножает на них соседний столбец.

БЫЛО:

100м2----0,3

НАДО:

м2-----30

Автор - grh1
Дата добавления - 27.02.2019 в 13:41
grh1 Дата: Среда, 27.02.2019, 13:45 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Да ладно? Уверены?

к сожалению нет на работе видео записать


Vadym Gorokh
 
Ответить
Сообщение
Да ладно? Уверены?

к сожалению нет на работе видео записать

Автор - grh1
Дата добавления - 27.02.2019 в 13:45
_Boroda_ Дата: Среда, 27.02.2019, 13:45 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Строчки местами поменял случайно
В посте выше исправил


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеСтрочки местами поменял случайно
В посте выше исправил

Автор - _Boroda_
Дата добавления - 27.02.2019 в 13:45
grh1 Дата: Среда, 27.02.2019, 13:52 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
Строчки местами поменял случайно

Да, сейчас супер - все работает.
Спасибо большое, Борода.


Vadym Gorokh
 
Ответить
Сообщение
Строчки местами поменял случайно

Да, сейчас супер - все работает.
Спасибо большое, Борода.

Автор - grh1
Дата добавления - 27.02.2019 в 13:52
boa Дата: Среда, 27.02.2019, 13:57 | Сообщение № 10
Группа: Друзья
Ранг: Ветеран
Сообщений: 549
Репутация: 167 ±
Замечаний: 0% ±

365
grh1,
выдает ошибку.

надо переменную задекларировать (вставить в начало макроса)
[vba]
Код
dim i&
[/vba]
З.Ы. в своем сообщении подправил


 
Ответить
Сообщениеgrh1,
выдает ошибку.

надо переменную задекларировать (вставить в начало макроса)
[vba]
Код
dim i&
[/vba]
З.Ы. в своем сообщении подправил

Автор - boa
Дата добавления - 27.02.2019 в 13:57
grh1 Дата: Среда, 27.02.2019, 14:34 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
_Boroda_,
Если Вас не затруднит, может можно как-то удалить столбец В, но при этом чтобы надписи в объединенных строках (выделил желтым) остались?
К сообщению приложен файл: 3639015.xls (40.5 Kb)


Vadym Gorokh
 
Ответить
Сообщение_Boroda_,
Если Вас не затруднит, может можно как-то удалить столбец В, но при этом чтобы надписи в объединенных строках (выделил желтым) остались?

Автор - grh1
Дата добавления - 27.02.2019 в 14:34
_Boroda_ Дата: Среда, 27.02.2019, 14:45 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Можно. А причем здесь эта тема?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеМожно. А причем здесь эта тема?

Автор - _Boroda_
Дата добавления - 27.02.2019 в 14:45
grh1 Дата: Среда, 27.02.2019, 14:47 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 200
Репутация: 0 ±
Замечаний: 40% ±

2019
А причем здесь эта тема?

да как то не захотелось плодить темы.
если это очень принципиально, то конечно создам тему.


Vadym Gorokh
 
Ответить
Сообщение
А причем здесь эта тема?

да как то не захотелось плодить темы.
если это очень принципиально, то конечно создам тему.

Автор - grh1
Дата добавления - 27.02.2019 в 14:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » макрос умножения числа с одного столбца на число с другого (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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