excel vba копировать значение из столбца и вставлять значение в ячейку

У меня есть данные, как показано ниже. Первый столбец принадлежит столбцу A, а второй столбец принадлежит столбцу B.

1 q 1 q 2 q 2 q 2 q 3 q 

Я хотел бы вставить пустые строки при изменении значений в столбце А. Чтобы вставить строки, я использую макрос с этого сайта .

 'select column a before running the macro Sub InsertRowsAtValueChange() 'Update 20140716 Dim Rng As Range Dim WorkRng As Range On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Application.ScreenUpdating = False For i = WorkRng.Rows.Count To 2 Step -1 If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then WorkRng.Cells(i, 1).EntireRow.Insert End If Next Application.ScreenUpdating = True End Sub 

После этого я хотел бы скопировать каждый набор значений из столбца A и вставить в ячейку в столбце C. Вставляя их, я хотел бы вставить значения в ячейку в формате строки (путем их конкатенации) и разделить их на пространство . В следующем случае ячейки c1 должны иметь 1 1 , ячейка c4 должна иметь 2 2 2 а ячейка c8 должна иметь 3

Как это сделать? Я попытался записать макрос, сначала скопировав каждый набор значений, затем вставив их после переноса в строку. Но мне снова трудно копировать значения и вставлять их в одну ячейку

До и после для кода ниже:

введите описание изображения здесь введите описание изображения здесь


 Option Explicit Sub InsertRowsAtValueChange() Dim rng As Range, itms As Variant, cel As Range, i As Long, firstRow As Long Set rng = Range("A3:A1000") firstRow = rng.Row - 1 Application.ScreenUpdating = False For i = rng.Rows.Count To 1 Step -1 If rng.Cells(i, 1).Value2 <> rng.Cells(i - 1, 1).Value2 Then If i < rng.Row - 1 Then Set cel = rng(i, 1) Else rng.Cells(i, 1).EntireRow.Insert Set cel = rng(i + 1, 1) End If With cel.CurrentRegion itms = .Columns(1) If .Columns(1).Rows.Count > 1 Then itms = Join(Application.Transpose(itms)) cel.Offset(0, 2) = itms End With End If If i = 1 Then Exit For Next Application.ScreenUpdating = True End Sub 

У меня есть эта функция, которая работает как встроенная функция Concatenate() , но дает вам возможности фильтрации. Я, кажется, не полностью помогаю вам, может дать вам другой подход к вашей конечной цели.

 Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, _ ConcatenateRange As Range, Optional Separator As String = ",") As Variant Dim i As Long Dim strResult As String On Error GoTo ErrHandler If CriteriaRange.Count <> ConcatenateRange.Count Then ConcatenateIf = CVErr(xlErrRef) Exit Function End If For i = 1 To CriteriaRange.Count If CriteriaRange.Cells(i).Value = Condition Then strResult = strResult & Separator & ConcatenateRange.Cells(i).Value End If Next i If strResult <> "" Then strResult = Mid(strResult, Len(Separator) + 1) End If ConcatenateIf = strResult Exit Function ErrHandler: ConcatenateIf = CVErr(xlErrValue) End Function 
  • Как объединить / объединить много несохраненных документов Excel в один?
  • Копирование и вставка данных
  • Копировать-вставить цикл с пропущенными значениями в VBA
  • Копировать из Excel / Numbers -> Webform
  • Проблема с новой строкой при копировании данных из SQL Server 2012 в Excel
  • Скопируйте сразу несколько листов (сохраняя относительные формулы)
  • Автозаполнение, изменяя только номер листа
  • Кнопка для копирования вставки в Excel
  • VBA с смещением диапазона
  • вставка изображения в указанном диапазоне с помощью vba
  • Слишком много времени, чтобы очистить таблицу, скопировать из другой книги, пасты и формулы автозаполнения
  • Interesting Posts

    Как читать данные из excel как таблицу базы данных, а также обновлять данные по запросу, основанному на использовании VSTO в C # .net?

    Определение того, соответствует ли случай двум квалификаторам, когда один квалификатор требует гибкости при определении правильности совпадения

    Фильтровать / Удалить свойства навигации EF5 с отражением

    Несколько цветов фона ячейки в таблицах Excel

    Индекс и совпадение с дополнительным условием (исключительно)

    инициализировать класс C # из excel VBA

    excel экспорт в pdf; смещение размещения графика

    Сравнение дат в двух столбцах с критериями соответствия

    VBA: автофильтр диапазона и копирование на существующий лист

    Python 3.3, файлы Excel не сохраняются в текущем рабочем каталоге

    Я не могу получить прикрепление электронной почты PHP

    CountIf HTML-тегов в Excel

    #VALUE ERROR из моей функции VBA

    формулы excel для условия

    Надстройка Excel, Как написать на лист excel

    Давайте будем гением компьютера.