首页 文章

excel vba复制值来自单元格中的列和粘贴值

提问于
浏览
1

我有如下数据 . 第一列属于A列,第二列属于B列 .

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

我想在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列的单元格中 . 在粘贴它们时,我想将 a cell 中的值粘贴到 a row format (by concatenating them) and separating them by a space 中 . 在下面的情况下,单元格c1应该具有 1 1 ,单元格c4应该具有 2 2 2 并且单元格c8应该具有 3

这该怎么做?我试图记录宏,首先复制每组值,然后在转换成行后粘贴它们 . 但我很难再次复制值并将它们粘贴在一个单元格中

2 回答

  • 1

    以下代码的前后:

    enter image description here

    enter image description here


    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
    

相关问题