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

我需要帮助。

在一个表中,我需要连接一个循环的列“a”+“b”+“c”,接下来的列“d”+“e”+“f”,等…一直到最后一列。

我的脚本被locking到第二个循环…

级联的结果将显示在第二个表单中。

结果应该是这样的:

这是我的不正确的代码:

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 qb = 3 + 1 ' sposta il concatena di 3 celle la selezione delle colonne Next c Terminate: 'error handler End Sub 

谢谢大家的帮助!

这个使用数组来加速一点:

 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 

你可以试试这个代码:

 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 

该解决scheme提供了灵活性,因为它使用variablesbClls来保存要连接的单元的数量。 假设源范围是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