Question

我需要帮助。

在一张表中，我需要连接一个循环列“a”+“b”+“c”，接下来的列“d”+“e”+“f”等...一个上升到最后一栏。

我的脚本被锁定到第二个循环......

连接结果将显示在第二张表格中。

这是我的错误代码：

Sub concatena()

Dim x As String
Dim Y As String

b = 1 'colonna selezionata

For c = 1 To 5 'colonne concatenate da riportare
For q = 1 To 10 'righe su cui effettuare l'operazione
For t = 1 To 3  'numero celle da concatenare

For Each cell In Worksheets(1).Cells(q, t) 
If cell.Value = "" Then GoTo Line1 
x = x & cell(1, b).Value & "" & ""

Next
Next t  
Line1:
On Error GoTo Terminate
Worksheets(2).Cells(q, c).Value = Mid(x, 1, Len(x))
x = ""  'mantiene la formattazione
Next q 
b = 3 + 1 ' sposta il concatena di 3 celle la selezione delle colonne
Next c

Terminate: 'error handler
End Sub

谢谢大家的帮助！

Answer 1

你可以试试这段代码：

Option Explicit

Sub concatena()
    Dim iRow As Long, iCol As Long, iCol2 As Long
    Dim arr As Variant

    With Worksheets("numbers")
        With .Cells(1, 1).CurrentRegion
            ReDim arr(1 To .Rows.Count, 1 To .Columns.Count / 3 + .Columns.Count Mod 3)
            For iRow = 1 To .Rows.Count
                iCol2 = 1
                For iCol = 1 To .Columns.Count Step 3
                    arr(iRow, iCol2) = Join(Application.Transpose(Application.Transpose(.Cells(iRow, iCol).Resize(, 3).Value)), "")
                    iCol2 = iCol2 + 1
                Next iCol
            Next iRow
            Worksheets("results").Range("A1").Resize(.Rows.Count, UBound(arr, 2)).Value = arr
        End With
    End With
End Sub

Answer 2

这个使用数组加速一点：

Sub concatena()
Dim inArr() As Variant
Dim oArr() As Variant
Dim i&, j&
Dim ws As Worksheet
Dim rng As Range

Set ws = Worksheets("Sheet9") ' change to your worksheet
With ws
    Set rng = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
    inArr = rng.Value
    ReDim oArr(1 To UBound(inArr, 1), 1 To UBound(inArr, 2) / 3)
    For i = LBound(inArr, 1) To UBound(inArr, 1)
        For j = LBound(inArr, 2) To UBound(inArr, 2) Step 3
            oArr(i, Int((j - 1) / 3) + 1) = inArr(i, j) & inArr(i, j + 1) & inArr(i, j + 2)
        Next j
    Next i
    rng.Clear
    .Range("A1").Resize(UBound(oArr, 1), UBound(oArr, 2)).Value = oArr
End With

Answer 3

此解决方案提供了灵活性，因为它使用变量bClls来保存要连接的单元格数。假设源范围是B2:M16，并且您希望连接每行的每3个单元格的值。它避免使用redim。

Sub Range_Concatenate_Cells_TEST()
Dim rSel As Range
Dim bClls As Byte
Dim rCllOut As Range
    bClls = 3 'change as required
    Set rSel = ThisWorkbook.Sheets("Sht(0)").Range("B2:M16") 'change as required
    Set rCllOut = ThisWorkbook.Sheets("Sht(1)").Cells(2, 2) 'change as required
    Call Range_Concatenate_Cells(bClls, rSel, rCllOut)
    End Sub

Sub Range_Concatenate_Cells(bClls As Byte, rSel As Range, rCllOut As Range)
Dim lRow As Long, iCol As Integer
Dim lRowOut As Long, iColOut As Integer
Dim vResult As Variant
    With rSel
        For lRow = 1 To .Rows.Count
            lRowOut = 1 + lRowOut
            iColOut = 0
            For iCol = 1 To .Columns.Count Step 3
                iColOut = 1 + iColOut
                vResult = .Cells(lRow, iCol).Resize(1, 3).Value2
                vResult = WorksheetFunction.Index(vResult, 0, 0)
                vResult = Join(vResult, "")
                rCllOut.Offset(-1 + lRowOut, -1 + iColOut).Value = vResult
    Next: Next: End With
    End Sub

Vba Excel - 将单元格值和循环连接到所有列

3 个答案: