时间戳

首页 > 解决方案 > 复制连接列并粘贴两次

excel - 复制连接列并粘贴两次

问题描述

我有一个宏，它为我将一些单元格连接在一起，然后将其粘贴到表 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

标签： excelvba

解决方案

试试这个，

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

推荐阅读