Перенести значения из строки

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Перенести значения из строки (Формулы/Formulas)

Obla4ko

Дата: Пятница, 08.07.2016, 19:41 | Сообщение № 1

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

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

Сообщений: 13

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

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

Excel 2010

Добрый день.

Имеется таблица - Детализация тел.разговоров. В ней порядка 20-и тысяч записей.
Стоит задача привести таблицу в удобочитаемый вид, а именно там где встречается в столбце "Код" значение "8495" перенести его в строку с номером, а значение "8499" оставить не тронутым.

Номера с кодом "8499" отображаются полностью, а вот "8495" обрезает.

Делаю это все при помощи макроса:

[vba]

Код

For Each c In Worksheets("Лист1").Range("A4:A6").Cells
c.Value = "8495" + CStr(c.Value)
Next

[/vba]

Но все бы да ничего, только вот записей очень много((

Помогите, чем можете.
[moder]Читаем Правила форума. Оформляем код тегами, прикладываем нормальный пример. Исправлено[/moder]

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

Сообщение отредактировал Obla4ko - Суббота, 09.07.2016, 08:33

Ответить

Pelena

Дата: Суббота, 09.07.2016, 08:47 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19182

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

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Можно формулой в доп. столбце

Код

=ЕСЛИ(C2=8495;C2&A2;A2)

Потом скопировать/вставить как значения на место первого столбца

К сообщению приложен файл: _1-1-.xlsx (9.7 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Obla4ko

Дата: Суббота, 09.07.2016, 09:43 | Сообщение № 3

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

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

Сообщений: 13

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

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

Excel 2010

Pelena, да, хороший способ, только если таблица небольшая. У меня записей около 20-и тысяч). Я в макросе меняю значение

Код

Range("A4:A6")

так мне кажется быстрее. Сегодня дошел до 6-и тысяч

Сообщение отредактировал Obla4ko - Суббота, 09.07.2016, 09:46

Ответить

Pelena

Дата: Суббота, 09.07.2016, 10:05 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 19182

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

Замечаний: ±

Excel 365 & Mac Excel

Формулу распространить на 20000 ячеек гораздо быстрее, на мой взгляд. Например, двойным кликом по маркеру заполнения (правый нижний угол ячейки с формулой)
Или ещё способы:
Быстрое заполнение диапазона значениями или формулами

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Karataev

Дата: Суббота, 09.07.2016, 14:45 | Сообщение № 5

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

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

Сообщений: 1334

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

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

Excel

Данный макрос сам определяет, сколько строк с данными на листе, и не нужно в коде изменять номер последней строки:
[vba]

Код

Sub Макрос()

    Dim arr1(), arr2(), lr As Long, i As Long

    Application.ScreenUpdating = False

    lr = Columns("C").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr1() = Range("C2:C" & lr).Value
    arr2() = Range("A2:A" & lr).Value

    For i = 1 To UBound(arr1)
        If arr1(i, 1) = 8495 Then
            arr2(i, 1) = CDbl(8495 & arr2(i, 1))
        End If
    Next

    Range("A2").Resize(UBound(arr2)).Value = arr2()

    Application.ScreenUpdating = True

End Sub

[/vba]

Ответить

Obla4ko

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

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

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

Сообщений: 13

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

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

Excel 2010

Профессионалы своего дела hands

Большое СПАСИБО ВСЕМ!!!

Ответить

Obla4ko

Дата: Понедельник, 11.07.2016, 22:01 | Сообщение № 7

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

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

Сообщений: 13

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

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

Excel 2010

А если в поле "Код" значение не "8495", а "8495777900" то как быть?

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

Ответить

Karataev

Дата: Понедельник, 11.07.2016, 22:08 | Сообщение № 8

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

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

Сообщений: 1334

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

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

Excel

[vba]

Код

Sub Макрос()

    Dim arr1(), arr2(), lr As Long, i As Long

    Application.ScreenUpdating = False

    lr = Columns("C").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr1() = Range("C2:C" & lr).Value
    arr2() = Range("A2:A" & lr).Value

    For i = 1 To UBound(arr1)
        If InStr(1, CStr(arr1(i, 1)), "8495", vbTextCompare) = 1 Then
            arr2(i, 1) = CDbl(8495 & arr2(i, 1))
        End If
    Next

    Range("A2").Resize(UBound(arr2)).Value = arr2()

    Application.ScreenUpdating = True

End Sub

[/vba]

Сообщение отредактировал Karataev - Понедельник, 11.07.2016, 22:11

Ответить

sv2014

Дата: Вторник, 12.07.2016, 00:09 | Сообщение № 9

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

Ранг: Форумчанин

Сообщений: 226

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

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

Excel 2013

Obla4ko, еще вариант макроса,кнопки test и повтор

[vba]

Код

Sub test()
     Dim z, i&: z = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = 1 To UBound(z): If z(i, UBound(z, 2)) = "8495" Then z(i, 1) = 8495 & z(i, 1)
    Next
     Range("A1").Resize(UBound(z), UBound(z, 2)) = z
End Sub

[/vba]

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

Ответить

sv2014

Дата: Вторник, 12.07.2016, 00:41 | Сообщение № 10

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

Ранг: Форумчанин

Сообщений: 226

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

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

Excel 2013

Obla4ko, добавил вариант с кнопкой test1 для Вашего сообщения7

[vba]

Код

Sub test1()
     Dim z, i&: z = Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
    For i = 1 To UBound(z): If z(i, UBound(z, 2)) = "8495" Or Left(z(i, UBound(z, 2)), 4) = "8495" Then z(i, 1) = 8495 & z(i, 1)
    Next
     Range("A1").Resize(UBound(z), UBound(z, 2)) = z
End Sub

[/vba]