Excel 连接两列之间的所有值
我需要将A列中的所有值与B列中的每个值连接起来。 比如说 此数据集：Excel 连接两列之间的所有值,excel,vba,Excel,Vba,我需要将A列中的所有值与B列中的每个值连接起来。 比如说 此数据集： Column A Column B Name Device1 Type Device2 Date Device3 Colour Device4 Device5 提供所需的输出： Device1Name Device2Name Device3Name Device1Type Devi
Column A Column B
Name Device1
Type Device2
Date Device3
Colour Device4
Device5
Device1Name Device2Name Device3Name
Device1Type Device2Type Device3Type
Device1Date Device2Date ...
Device1Colour Device2Colour
Sub conbineData()
Dim Cola As Range: Set Cola = Range(Cells(1, 1), Cells(4, 1)) 'Where this is the first set of data: Name, Type, Date, Colour
Dim Colb As Range: Set Colb = Range(Cells(1, 2), Cells(7, 2)) 'Here you have the device: Device1, Device2 and so on
Dim i As Range
Dim j As Range
Dim ac As Integer: ac = 5 'This is because in my example, i have everything in cols A and B
'and I want to put the result data in column F (5+1=6)
Dim bc As Integer: bc = 0 'Here I set this var to 0 because I will add the numbers of the rows in the loop
For Each i In Colb
ac = ac + 1 'remember: column F (5+1=6)
For Each j In Cola
bc = bc + 1 'Here the rows!
Range(Cells(bc, ac), Cells(bc, ac)).Value = i & j
Next j
bc = 0 'here need to reset the var to from row 1 to the last row/data
Next i
End Sub
+---+-------+---------+
| | A | B |
+---+-------+---------+
| 1 | name | device1 |
+---+-------+---------+
| 2 | type | device2 |
+---+-------+---------+
| 3 | date | device3 |
+---+-------+---------+
| 4 | color | device4 |
+---+-------+---------+
| 5 | | device5 |
+---+-------+---------+
| 6 | | device6 |
+---+-------+---------+
| 7 | | device7 |
+---+-------+---------+
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| | F | G | H | I | J | K | L |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 1 | device1name | device2name | device3name | device4name | device5name | device6name | device7name |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 2 | device1type | device2type | device3type | device4type | device5type | device6type | device7type |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 3 | device1date | device2date | device3date | device4date | device5date | device6date | device7date |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 4 | device1color | device2color | device3color | device4color | device5color | device6color | device7color |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
Sub conbineData()
Dim Cola As Range: Set Cola = Range(Cells(1, 1), Cells(4, 1)) 'Where this is the first set of data: Name, Type, Date, Colour
Dim Colb As Range: Set Colb = Range(Cells(1, 2), Cells(7, 2)) 'Here you have the device: Device1, Device2 and so on
Dim i As Range
Dim j As Range
Dim ac As Integer: ac = 5 'This is because in my example, i have everything in cols A and B
'and I want to put the result data in column F (5+1=6)
Dim bc As Integer: bc = 0 'Here I set this var to 0 because I will add the numbers of the rows in the loop
For Each i In Colb
ac = ac + 1 'remember: column F (5+1=6)
For Each j In Cola
bc = bc + 1 'Here the rows!
Range(Cells(bc, ac), Cells(bc, ac)).Value = i & j
Next j
bc = 0 'here need to reset the var to from row 1 to the last row/data
Next i
End Sub
+---+-------+---------+
| | A | B |
+---+-------+---------+
| 1 | name | device1 |
+---+-------+---------+
| 2 | type | device2 |
+---+-------+---------+
| 3 | date | device3 |
+---+-------+---------+
| 4 | color | device4 |
+---+-------+---------+
| 5 | | device5 |
+---+-------+---------+
| 6 | | device6 |
+---+-------+---------+
| 7 | | device7 |
+---+-------+---------+
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| | F | G | H | I | J | K | L |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 1 | device1name | device2name | device3name | device4name | device5name | device6name | device7name |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 2 | device1type | device2type | device3type | device4type | device5type | device6type | device7type |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 3 | device1date | device2date | device3date | device4date | device5date | device6date | device7date |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 4 | device1color | device2color | device3color | device4color | device5color | device6color | device7color |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
Option Explicit
' Run only this. Adjust the seven consecutive constants as you see fit.
Sub Combine()
Const Proc As String = "Combine"
On Error GoTo cleanError
Const srcName As String = "Sheet1"
Const FirstRow As Long = 1
Const FirstColumn As Variant = 2
Const CombineColumn As Variant = 1
Const tgtName As String = "Sheet1"
Const tgtFirstCell As String = "E1"
Const Concatenator As String = ""
Dim wsSource As Worksheet ' Source Worksheet
Dim wsTarget As Worksheet ' Target Worksheet
Dim First As Variant ' First Column Array
Dim Combine As Variant ' Combine Column Array
Dim Target As Variant ' Target Array
Dim isWritten As Boolean ' Write Checker
Set wsSource = ThisWorkbook.Worksheets(srcName)
' Write Column Ranges to Column Arrays.
First = getColumn(wsSource, FirstColumn, FirstRow)
Combine = getColumn(wsSource, CombineColumn, FirstRow)
' Combine Column Arrays to Target Array.
If IsEmpty(First) Or IsEmpty(Combine) Then Exit Sub
Target = combineColumns(First, Combine, Concatenator)
' Write Target Array to Target Range
Set wsTarget = ThisWorkbook.Worksheets(tgtName)
isWritten = writeToFirstCell(Target, wsTarget, tgtFirstCell)
'Inform user.
If isWritten Then
MsgBox "Data successfully transferred.", vbInformation
Else
MsgBox "Data not transferred.", vbExclamation
End If
Exit Sub
cleanError:
MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
& "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
, vbCritical, Proc & " Error"
On Error GoTo 0
End Sub
' Writes the values of a non-empty worksheet column range
' to a 2D one-based one-column array.
Function getColumn(Sheet As Worksheet, _
ByVal ColumnNumberOrLetter As Variant, _
Optional ByVal FirstRow As Long = 1) As Variant
Dim rng As Range
Set rng = Sheet.Columns(ColumnNumberOrLetter) _
.Find("*", , xlFormulas, , , xlPrevious)
If rng Is Nothing Then Exit Function
If rng.Row < FirstRow Then Exit Function
getColumn = Sheet.Range(Sheet.Cells(FirstRow, ColumnNumberOrLetter), rng)
End Function
' Combines two 2D one-based one-column arrays to another 2D one-based array.
' First the first element of FirstColumn will be combined (concatenated)
' with each element of CombineColumn (in the first column of resulting array),
' then the second element of FirstColumn ...etc. The resulting array will have
' as many rows as elements in CombineColumn and as many columns as elements
' in FirstColumn.
Function combineColumns(ByVal FirstColumn As Variant, _
ByVal CombineColumn As Variant, _
Optional ByVal Concatenator As String = "") As Variant
Dim i As Long, j As Long, k As Long
ReDim Target(1 To UBound(CombineColumn), _
1 To UBound(FirstColumn))
For j = 1 To UBound(FirstColumn)
For i = 1 To UBound(CombineColumn)
Target(i, j) = FirstColumn(j, 1) _
& Concatenator & CombineColumn(i, 1)
Next i
Next j
combineColumns = Target
End Function
' Writes a 2D one-based array to a worksheet.
Function writeToFirstCell(Source2D1B As Variant, Sheet As Worksheet, _
Optional ByVal FirstCellAddress = "A1") As Boolean
On Error GoTo exitProcedure
Sheet.Range(FirstCellAddress) _
.Resize(UBound(Source2D1B), UBound(Source2D1B, 2)) = Source2D1B
writeToFirstCell = True
Exit Function
exitProcedure:
End Function
Option Explicit
' Run only this. Adjust the seven consecutive constants as you see fit.
Sub Combine()
Const Proc As String = "Combine"
On Error GoTo cleanError
Const srcName As String = "Sheet1"
Const FirstRow As Long = 1
Const FirstColumn As Variant = 2
Const CombineColumn As Variant = 1
Const tgtName As String = "Sheet1"
Const tgtFirstCell As String = "E1"
Const Concatenator As String = ""
Dim wsSource As Worksheet ' Source Worksheet
Dim wsTarget As Worksheet ' Target Worksheet
Dim First As Variant ' First Column Array
Dim Combine As Variant ' Combine Column Array
Dim Target As Variant ' Target Array
Dim isWritten As Boolean ' Write Checker
Set wsSource = ThisWorkbook.Worksheets(srcName)
' Write Column Ranges to Column Arrays.
First = getColumn(wsSource, FirstColumn, FirstRow)
Combine = getColumn(wsSource, CombineColumn, FirstRow)
' Combine Column Arrays to Target Array.
If IsEmpty(First) Or IsEmpty(Combine) Then Exit Sub
Target = combineColumns(First, Combine, Concatenator)
' Write Target Array to Target Range
Set wsTarget = ThisWorkbook.Worksheets(tgtName)
isWritten = writeToFirstCell(Target, wsTarget, tgtFirstCell)
'Inform user.
If isWritten Then
MsgBox "Data successfully transferred.", vbInformation
Else
MsgBox "Data not transferred.", vbExclamation
End If
Exit Sub
cleanError:
MsgBox "An unexpected error occurred in '" & Proc & "'." & vbCr _
& "Run-time error '" & Err.Number & "':" & vbCr & Err.Description _
, vbCritical, Proc & " Error"
On Error GoTo 0
End Sub
' Writes the values of a non-empty worksheet column range
' to a 2D one-based one-column array.
Function getColumn(Sheet As Worksheet, _
ByVal ColumnNumberOrLetter As Variant, _
Optional ByVal FirstRow As Long = 1) As Variant
Dim rng As Range
Set rng = Sheet.Columns(ColumnNumberOrLetter) _
.Find("*", , xlFormulas, , , xlPrevious)
If rng Is Nothing Then Exit Function
If rng.Row < FirstRow Then Exit Function
getColumn = Sheet.Range(Sheet.Cells(FirstRow, ColumnNumberOrLetter), rng)
End Function
' Combines two 2D one-based one-column arrays to another 2D one-based array.
' First the first element of FirstColumn will be combined (concatenated)
' with each element of CombineColumn (in the first column of resulting array),
' then the second element of FirstColumn ...etc. The resulting array will have
' as many rows as elements in CombineColumn and as many columns as elements
' in FirstColumn.
Function combineColumns(ByVal FirstColumn As Variant, _
ByVal CombineColumn As Variant, _
Optional ByVal Concatenator As String = "") As Variant
Dim i As Long, j As Long, k As Long
ReDim Target(1 To UBound(CombineColumn), _
1 To UBound(FirstColumn))
For j = 1 To UBound(FirstColumn)
For i = 1 To UBound(CombineColumn)
Target(i, j) = FirstColumn(j, 1) _
& Concatenator & CombineColumn(i, 1)
Next i
Next j
combineColumns = Target
End Function
' Writes a 2D one-based array to a worksheet.
Function writeToFirstCell(Source2D1B As Variant, Sheet As Worksheet, _
Optional ByVal FirstCellAddress = "A1") As Boolean
On Error GoTo exitProcedure
Sheet.Range(FirstCellAddress) _
.Resize(UBound(Source2D1B), UBound(Source2D1B, 2)) = Source2D1B
writeToFirstCell = True
Exit Function
exitProcedure:
End Function
尝试以下简单代码，该代码与A列或B列中的项目数无关：
Sub ConcatCols()
'Iterate over all cells in column A, unitl reach to the first empty cell
Dim ra As Integer
ra = 1
Do Until IsEmpty(Cells(ra, 1))
'Iterate over all cells in column B, unitl reach to the first empty cell
Dim rb As Integer
rb = 1
Do Until IsEmpty(Cells(rb, 2))
'Concatenate values and write in the next columns at row ra
Cells(ra, 2 + rb).Value = Cells(rb, 2).Text & Cells(ra, 1).Text
rb = rb + 1
Loop
ra = ra + 1
Loop
End Sub
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| | F | G | H | I | J | K | L |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 1 | device1name | device2name | device3name | device4name | device5name | device6name | device7name |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 2 | device1type | device2type | device3type | device4type | device5type | device6type | device7type |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 3 | device1date | device2date | device3date | device4date | device5date | device6date | device7date |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 4 | device1color | device2color | device3color | device4color | device5color | device6color | device7color |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
尝试以下简单代码，该代码与A列或B列中的项目数无关：
Sub ConcatCols()
'Iterate over all cells in column A, unitl reach to the first empty cell
Dim ra As Integer
ra = 1
Do Until IsEmpty(Cells(ra, 1))
'Iterate over all cells in column B, unitl reach to the first empty cell
Dim rb As Integer
rb = 1
Do Until IsEmpty(Cells(rb, 2))
'Concatenate values and write in the next columns at row ra
Cells(ra, 2 + rb).Value = Cells(rb, 2).Text & Cells(ra, 1).Text
rb = rb + 1
Loop
ra = ra + 1
Loop
End Sub
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| | F | G | H | I | J | K | L |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 1 | device1name | device2name | device3name | device4name | device5name | device6name | device7name |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 2 | device1type | device2type | device3type | device4type | device5type | device6type | device7type |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 3 | device1date | device2date | device3date | device4date | device5date | device6date | device7date |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+
| 4 | device1color | device2color | device3color | device4color | device5color | device6color | device7color |
+---+--------------+--------------+--------------+--------------+--------------+--------------+--------------+