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

【问题标题】：excel vba copy value from a column and paste value in a cellexcel vba从列中复制值并将值粘贴到单元格中
【发布时间】：2017-07-04 19:11:34
【问题描述】：

我有如下数据。第一列属于 A 列，第二列属于 B 列。

我想在 A 列中的值发生变化时插入空行。要插入行，我使用来自this site 的宏。

'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

如何做到这一点？我尝试使用首先复制每组值然后在转置成一行后粘贴它们来记录宏。但是我很难再次复制值并将它们粘贴到单个单元格中

【问题讨论】：

想要将值粘贴到单个单元格中是什么意思？您是否尝试将所有值连接在一起？
是的，连接值并用空格分隔它们

标签： excel copy-paste transpose vba

【解决方案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

【讨论】：

是否可以更改代码以使 workRng 始终为 A3:A1000？
我试过 Set workRng = Range("A3:A1000") 并评论了 xTitleId = "KutoolsforExcel" Set workRng = Application.Selection Set workRng = Application.InputBox("Range", xTitleId, workRng.Address, Type:=8)，但它没有用
当然 - 我现在正在做出改变
好的，我会等你的答复
看起来不错。我测试了它。如果出现意外情况，我会通知您

【解决方案2】：

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

【讨论】：