excel vba从列中复制值并将值粘贴到单元格中

我有像下面的数据。 第一列属于A列，第二列属于B列。

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

我想在列A中的值发生更改时插入空行。 插入行我正在使用这个站点的macros。

 '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

这个怎么做？ 我试图loggingmacros使用第一次复制每个值集，然后粘贴他们后，换成一行。 但我很难再次复制值并粘贴到一个单元格中

Answer 1

代码之前和之后的代码：

---

 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 

---

Answer 2

我有这个function就像内置的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