VBA Excel - セルの値とループをすべての列に連結します。

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

この1つは少しそれをスピードアップするための配列を使用しています。それは数を保持する変数bCllsを使用するよう

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

このソリューションは、柔軟性を提供連結されるべき細胞。 ソース範囲が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