VBA Excel - 셀 값과 루프를 모든 열에 연결

Question

도움이 필요합니다.

시트에서 "a"+ "b"+ "c", 다음에 "d"+ "e"+ "f"등의 루프를 연결해야합니다. 마지막 열. 내 스크립트는 제 2 고리에 고정되어

...

연접 결과가 제 2 시트에 표시한다.

이 내 잘못된 코드입니다 :

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

이 하나가 속도를 배열을 사용하는 작은 :

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 2

이 코드를 시도 할 수 있습니다 :

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 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