Вопрос:
У меня есть данные, как показано ниже. Первый столбец принадлежит столбцу 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 Ответ №1
У меня есть эта функция, которая работает как встроенная функция 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
