Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.02.2010, 08:43   #1
agregator
Форумчанин
 
Аватар для agregator
 
Регистрация: 09.05.2009
Сообщений: 369
По умолчанию Вернуть исходный вид таблицы

Всем здравствуйте. В отчете сначала идёт строка Гаражный номер: ХХ, далее идут строки с перечнем наименований МЦ (запчастей) и Итого по Гаражному номеру ХХ. Подскажите как макросом перед каждой наименованием МЦ проставить ХХ (гаражный номер) и удалить строки Гаражный номер: ХХ и строки Итого по Гаражному номеру ХХ.
Во вложении пример, что "Есть" и что "Надо".
Вложения
Тип файла: zip Есть и Надо.zip (14.5 Кб, 10 просмотров)
agregator вне форума Ответить с цитированием
Старый 21.02.2010, 09:40   #2
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Код:

Sub KILLER()
Const prim As String = "Гаражный номер:"

Const second As String = "Итого по Гаражному номеру"

Dim flg1 As Boolean

Dim zam As String

    Columns(1).Insert
   Dim rng As Range
 Set rng = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
   For n = 1 To Cells(Rows.Count, 2).End(xlUp).Row
   If Cells(n, 2).Text Like "*" & prim & "*" Then
   flg1 = True
 
    Cells(n, 2).Interior.ColorIndex = 3
    zam = Replace(Cells(n, 2).Text, prim, "")
   End If
   
   If Cells(n, 2).Text Like "*" & second & "*" Then
    flg1 = False

    Cells(n, 2).Interior.ColorIndex = 3
   
   End If
   
   If flg1 = True Then
     Cells(n, 1) = zam
   
   End If
   
   Next
   
    Dim cell As Range
    Set ra = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
   For Each cell In ra.Cells
      
        If cell.Interior.ColorIndex = 3 Then
          
        Rows(cell.Row).Delete
                     
     End If
       
    Next cell
  
End Sub
Анализ,обработка данных Недорого
doober вне форума Ответить с цитированием
Старый 21.02.2010, 09:57   #3
agregator
Форумчанин
 
Аватар для agregator
 
Регистрация: 09.05.2009
Сообщений: 369
По умолчанию

Doober, большое спасибо, работает как надо.
agregator вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Исходный код страницы Abuhamed PHP 5 02.02.2010 00:34
Вывести исходный код на экран SoftKoc Общие вопросы Delphi 5 23.01.2010 08:52
Расформатировать исходный код страницы OdNairy Работа с сетью в Delphi 5 19.09.2009 18:13
Помогите найти исходный код KEYRUS kaeromorte Помощь студентам 3 24.05.2009 01:14
Как прочесть исходный текст? Ruber Общие вопросы по Java, Java SE, Kotlin 0 05.06.2008 21:45