我有一个电子表格,其值类似于以下内容:
是否有任何可能的方法来创建 VBA 将每个 ID 和类的所有单独数据连接到一行中?最终结果如下所示?
Sub JoinRowsData()
Dim lastRow As Long, i As Long, j As Long, k As Long
Application.ScreenUpdating = False
lastRow = Range("C" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
For j = i + 1 To lastRow
If Cells(i, 2) = Cells(j, 2) Then
For k = 5 To 10
If (Cells(i, k) = "" And Cells(j, k) <> "") Then
Cells(i, k) = Cells(j, k)
End If
Next
End If
Next
Next
Application.ScreenUpdating = True
End Sub
最佳答案
下面的内容就可以做到这一点。请参阅评论以了解其工作原理的说明。它使用数组来处理数据,比直接处理单元格要快得多。
Option Explicit
Public Sub JoinRowsData()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long ' get last used row in worksheet
LastRow = GetLastUsed(xlByRows, ws)
Dim LastCol As Long ' get last used column in worksheet
LastCol = GetLastUsed(xlByColumns, ws)
' Read data into an array for faster processing
Dim Data() As Variant
Data = ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2
' define an output array with the same size
Dim Output() As Variant
ReDim Output(1 To UBound(Data, 1), 1 To UBound(Data, 2))
Dim outRow As Long ' output row index
Dim iRow As Long
For iRow = 1 To LastRow ' loop through all rows in data
' if column 1 contains data it is a new output row
If Data(iRow, 1) <> vbNullString Then
outRow = outRow + 1
End If
' loop through all columns in a data row
Dim iCol As Long
For iCol = 1 To LastCol
If Data(iRow, iCol) <> vbNullString Then ' check if current cell has data
If Output(outRow, iCol) <> vbNullString Then
' add a line break if there is already data in the output cell
Output(outRow, iCol) = Output(outRow, iCol) & vbLf
End If
' add the data to the output cell
Output(outRow, iCol) = Output(outRow, iCol) & Data(iRow, iCol)
End If
Next iCol
Next iRow
' write all the output data from the array back to the cells
ws.Range("A1", ws.Cells(LastRow, LastCol)).Value2 = Output
End Sub
' find last used row or column in worksheet
Public Function GetLastUsed(ByVal RowCol As XlSearchOrder, ByVal InWorksheet As Worksheet) As Long
With InWorksheet
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
Dim LastCell As Range
Set LastCell = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=RowCol, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If RowCol = xlByRows Then
GetLastUsed = LastCell.Row
Else
GetLastUsed = LastCell.Column
End If
Else
GetLastUsed = 1
End If
End With
End Function
关于excel - 将文本连接到不同行和列的一个单元格中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/70968506/