Question

我必须创建一个宏，它允许我在给定范围内一次连接两列。例如：在C1：Z200范围内，我想连接C和D列，E＆amp; F，G＆amp; H等。我该怎么做。这是我当前的代码，它只连接前两列.rest仍然是相同的。

Set Range = ActiveSheet.Range("C1:Z100")
For Each c In Range
    c.Select
    ActiveCell.FormulaR1C1 = ActiveCell & " " & ActiveCell.Offset(0, 1)
    ActiveCell.Offset(0, 1).Activate
    Selection.Clear
    ActiveCell.Offset(0, 2).Activate
Next c

Answer 1

试试这个：

Sub Concat()
Dim i As Long, j As Long
For i = 1 To 100 'number of rows
    j = 1 'reset column to 1
    Do While j < 25 'max number of columns (until Column Y-Z)
        j = j + 2 'start from third column (Column C)
        Cells(i, j) = Cells(i, j) & " " & Cells(i, j + 1) 'concat
        Cells(i, j + 1).ClearContents 'clear
    Loop
Next i 'next row
End Sub

Answer 2

试试这个：

Sub ConcatAltCellsInAltCols()
    Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Sheet11")
    Dim iLC As Long: iLC = oW.Cells(1, oW.Columns.Count).End(xlToLeft).Column
    Dim iLR As Long: iLR = oW.Cells(oW.Rows.Count, 3).End(xlUp).Row
    Dim iC As Long
    Dim iR As Long

    For iR = 1 To iLR
        For iC = 3 To iLC Step 2
            oW.Cells(iR, iC).Value = oW.Cells(iR, iC) & oW.Cells(iR, iC + 1)
        Next
    Next
End Sub

Answer 3

尝试使用基于一个数组的阵列以获得更好的性能：

<强>代码

Option Explicit
Sub Conc()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Concat")  ' <== change "Concat" to your sheet name to avoid subscript error
Dim v       ' variant
Dim lng As Long
Dim j   As Integer          ' corr.
' use one based array to get field data
  v = ws.Range("C1:Z100")   ' your OP range
  For lng = 1 To UBound(v)
  ' concatenate columns C&D, E&F, G&H, ...
    For j = 0 To 11
       v(lng, j * 2 + 1) = v(lng, j * 2 + 1) & v(lng, j * 2 + 2)
    Next j

  Next lng
' write array values back (overwriting D, F, H,... with the same values)
  ws.Range("C1:Z100") = v     ' your OP range
End Sub

宏在一个范围内一次连接两列

3 个答案: