复制连接列并粘贴两次

Question

我有一个宏可以将一些单元格连接在一起，然后将其粘贴到工作表 2 和 3。但是我需要它重复每个单元格两次

Sheet2 只需要从单元格 A2 到 A14 并从 J14 开始粘贴到 Sheet2

Sheet3 需要从单元格 A15 到最后一行的所有内容，并从 J8 开始粘贴到 Sheet3 中

我的代码似乎不适用于我的 sheet3，但 sheet1 工作正常

示例：在我的工作表 1 中将是

  A   |   B  |  C
--------------------
Name1 | date | info
Name2 | date | info

在我连接所有我需要的东西之后

          A         |
--------------------
Name1 - date - info |
Name1 - date - info |
Name2 - date - info |
Name2 - date - info |

我当前的代码：

Sub Concat()
Sheets("Sheet1").Select
Dim lRow As Long, i As Long
Dim rng As Range
Dim lr2 As Long

Set rng = Range("A16:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rng2 = Range("A15:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Debug.Print rng.Address(External:=True)
lr2 = 1
lRow = rng.Row
For i = 2 To lRow

    ActiveWorkbook.Sheets("Sheet2").Cells(i + 12, 10) = Cells(i, 1) & " - " & Cells(i, 2) & " - " & Cells(i, 3) & " - " & Cells(i, 4)
  Next i

   lRow2 = rng2.Row
For i = 2 To lRow2
   ActiveWorkbook.Sheets("Sheet3").Cells(i + 6, 10) = Cells(i + 15, 1) & " - " & Cells(i + 15, 2) & " - " & Cells(i + 15, 3) & " - " & Cells(i + 15, 4)
  
  Next i
End Sub

我找到了一个重复该列的代码，但我无法在我的代码中实现它

    Sub copPas()


Dim s1 As Worksheet, s2 As Worksheet

Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")

Dim lr As Long, lr2 As Long
Dim i As Long


lr = s1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = 1

Application.ScreenUpdating = False

For i = 1 To lr
s2.Range("A" & lr2).Resize(2).Value = s1.Range("A" & i).Value
lr2 = lr2 + 2
Next i

Application.ScreenUpdating = True



End Sub

Answer 1

试试这个，

Sub concat()
  Dim shtSrc As Worksheet
  Dim shtDest1 As Worksheet
  Dim shtDest2 As Worksheet
  
  Dim lStartRow As Long: lStartRow = 2
  Dim lDest1SrcEndsAt As Long: lDest1SrcEndsAt = 14
  Dim lLastRow As Long
  Dim vData As Variant
  
  Dim aOutput() As String
  Dim lRepeats As Long: lRepeats = 2
  Dim lRows As Long
  Dim i As Long
  Dim j As Long
  
  With ThisWorkbook
    Set shtSrc = .Sheets("Sheet1")
    Set shtDest1 = .Sheets("Sheet2")
    Set shtDest2 = .Sheets("Sheet3")
  End With
  
  With shtSrc
    lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    If lLastRow < lStartRow Then lLastRow = lStartRow
    vData = .Range(.Range("A1"), .Range("C" & lLastRow)).Value2
  End With
  
  lRows = 0
  For i = lStartRow To lDest1SrcEndsAt
    lRows = lRows + lRepeats
    ReDim Preserve aOutput(1 To lRows)
    
    For j = 0 To lRepeats - 1
      aOutput(lRows - j) = vData(i, 1) & " - " & vData(i, 2) & " - " & vData(i, 3)
    Next j
  Next i
  With shtDest1.Range("J14")
    .Resize(Rows.Count - .Row).ClearContents
    .Resize(lRows, 1).Value2 = WorksheetFunction.Transpose(aOutput)
  End With
  
  lRows = 0
  For i = lDest1SrcEndsAt + 1 To lLastRow
    lRows = lRows + lRepeats
    ReDim Preserve aOutput(1 To lRows)
    
    For j = 0 To lRepeats - 1
      aOutput(lRows - j) = vData(i, 1) & " - " & vData(i, 2) & " - " & vData(i, 3)
    Next j
  Next i
  With shtDest2.Range("J8")
    .Resize(Rows.Count - .Row).ClearContents
    .Resize(lRows, 1).Value2 = WorksheetFunction.Transpose(aOutput)
  End With
End Sub

Answer 2

我有一个宏可以将一些单元格连接在一起，然后将其粘贴到工作表 2 和 3。但是我需要它重复每个单元格两次

另一种不涉及任何循环的方式。

逻辑：

1. 使用index(concatenate()) 一次性连接所有数据，无需任何循环。 Explanation about index(concatenate())
2. 转到目标工作表的最后一行并再次执行步骤 1
3. 对数据进行排序

代码

Option Explicit

Dim wsThis As Worksheet
Dim wsThisLastRow As Long
Dim sAddr As String
Dim rngA As String, rngB As String, rngC As String

'~~> Delimiter
Const delim As String = """ - """

Sub Sample()
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    
    '~~> Source Sheet
    Set wsThis = Sheet1
    
    With wsThis
        wsThisLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        sAddr = "A1:A" & wsThisLastRow
    
        rngA = "'" & .Name & "'!A1:A" & wsThisLastRow
        rngB = "'" & .Name & "'!B1:B" & wsThisLastRow
        rngC = "'" & .Name & "'!C1:C" & wsThisLastRow
    End With
    
    Set wsA = Sheet2: Set wsB = Sheet3
    
    '~~> Generate Data twice in Sheet 2
    ConcatenateData wsA, 1, wsThisLastRow
    ConcatenateData wsA, wsThisLastRow + 1, 2 * wsThisLastRow
    
    '~~> Sort
    wsA.Columns(1).Sort Key1:=wsA.Range("A1"), _
                        Order1:=xlAscending, _
                        Header:=xlNo, _
                        OrderCustom:=1, _
                        MatchCase:=False, _
                        Orientation:=xlTopToBottom, _
                        DataOption1:=xlSortNormal

    
    '~~> Generate Data twice in Sheet 3
    ConcatenateData wsB, 1, wsThisLastRow
    ConcatenateData wsB, wsThisLastRow + 1, 2 * wsThisLastRow
    
    '~~> Sort
    wsB.Columns(1).Sort Key1:=wsB.Range("A1"), _
                        Order1:=xlAscending, _
                        Header:=xlNo, _
                        OrderCustom:=1, _
                        MatchCase:=False, _
                        Orientation:=xlTopToBottom, _
                        DataOption1:=xlSortNormal
End Sub

'~~> Conatenate the columns in 1 go
Private Sub ConcatenateData(ws As Worksheet, StartRow As Long, EndRow As Long)
    ws.Range("A" & StartRow & ":A" & EndRow).Value = _
    Evaluate("index(concatenate(" & rngA & "," & delim & "," & _
                                    rngB & "," & delim & "," & _
                                    rngC & "),)")
End Sub

行动中

有没有办法让连接的输出最多有 50 个字符？ – araau11 1 分钟前

在这种情况下你可以使用index(Left(concatenate()))

'~~> Conatenate the columns in 1 go
Private Sub ConcatenateData(ws As Worksheet, StartRow As Long, EndRow As Long)
    ws.Range("A" & StartRow & ":A" & EndRow).Value = _
    Evaluate("index(Left(concatenate(" & rngA & "," & delim & "," & _
                                    rngB & "," & delim & "," & _
                                    rngC & "),50),)")
End Sub