我当前的电子表格有两列要合并的数据。在提供的代码中，我在要合并的列的右侧创建了一个列，然后使用FOR循环将每个值与值之间的“，”组合。我想调整代码以跳过没有值的单元格/行，因为如果两个初始列都没有值，那么我现在在合并列中以“，”结尾。
Public Sub MergeLatLong()
Dim LastRow As Long
Worksheets("Raw_Data").Activate
Columns("AT:AT").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = Range("AR" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
Cells(i, 46) = Cells(i, 44) & ", " & Cells(i, 45)
Next i
End Sub
答案 0 :(得分：1)
Do you need to use VBA? I would recommend using a TEXTJOIN formula (if you have Excel 2016). Assuming your cells in columns AR and AS and the formula in AT.
The parameters for the formula are =TEXTJOIN(delimiter,ingnore_blanks,range)
So the below formula in AT1 would return a concatenation of the two columns for each row with a comma as the delimiter if there is contents in both columns.
=TEXTJOIN(“,”,TRUE,AR1:AS1)
If you are using a version less than 2016. You could just use the following
=AR1&IF(ISBLANK(AS1),””,”, AS1”)
Either of these can be dragged down and you wouldn’t have any extra commas in any rows with a blank in column AS.
答案 1 :(得分：1)
下面的代码应该可以实现您的预期。如果两个值都缺失，它将输入一个空白；如果第二个缺失，则第一个（无逗号）；如果第一个缺失，则仅第二个（带逗号）。您可以调整该部分以更好地满足您的需求。
Public Sub MergeLatLong()
Dim Ws As Worksheet
Dim LastRow As Long
Dim Combo As String, Tmp As String
Dim R As Long
' No need to Activate or Select anything!
Set Ws = Worksheets("Raw_Data")
With Ws
.Columns(46).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
LastRow = .Cells(Rows.Count, "AR").End(xlUp).Row
For R = 2 To LastRow
' if you mean the 'Value' it's better to specify the 'Value' property
Combo = Trim(.Cells(R, 44).Value) ' treat Space as blank
Tmp = Trim(.Cells(R, 45).Value) ' treat Space as blank
If Len(Tmp) Then Tmp = ", " & Tmp
If Len(Combo) And Len(Tmp) > 0 Then Combo = Combo & Tmp
Cells(R, 46).Value = Combo
Next R
End With
End Sub
与@Dude Scott一样，我也觉得工作表函数可能更合适。如果VBA仅是经常重复执行的任务，它可能会具有一些优势。
如果条目数很大，请在For .. Next循环之前添加Application.ScreenUpdating = False，并在该过程结束时将ScreenUpdating重置为True。这样可以大大提高速度。
答案 2 :(得分：0)
您可以遍历列AR而不是空白单元格，并检查列AS的内容以正确添加逗号
此外，请避免使用“激活/选择”模式，并使用对范围的直接和显式引用：
Public Sub MergeLatLong()
Dim cell As Range
With Worksheets("Raw_Data") ' reference wanted worksheet
.Columns("AT:AT").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For Each cell In .Range("AR2", .Cells(.Rows.Count, "AR").End(xlUp)).SpecialCells(xlCellTypeConstants) ' loop through referenced sheet column AR cells with some "constant" values
If IsEmpty(cell.Offset(, 1)) Then
cell.Offset(, 2) = cell.Value
Else
cell.Offset(, 2) = cell.Value & ", " & cell.Offset(, 1)
End If
Next
End With
End Sub
答案 3 :(得分：0)
Sub MergeLatLong() ' Array Version
Dim vnt1 As Variant ' 1st Array
Dim vnt2 As Variant ' 2nd Array
Dim vntR As Variant ' Result Array
Dim NoR As Long ' Number of Rows
Dim i As Long ' Row Counter
Dim str1 As String ' 1st String
Dim str2 As String ' 2nd String
Dim strR As String ' Result String
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Handle possible error.
On Error GoTo ErrorHandler
With ThisWorkbook.Worksheets("Raw_Data")
' Insert column ("AT") to the right of column ("AS").
.Columns("AT").Insert xlToRight, xlFormatFromLeftOrAbove
' Calculate Number of Rows (Last Used Row - First Row + 1).
NoR = .Cells(.Rows.Count, "AR").End(xlUp).Row - 2 + 1
' Copy values of column "AR" to 1st Array.
vnt1 = .Columns("AR").Cells(2).Resize(NoR)
' Copy values of column "AS" to 2nd Array.
vnt2 = .Columns("AS").Cells(2).Resize(NoR)
End With
' Resize Result Array to size of 1st Array (or 2nd Array).
ReDim vntR(1 To UBound(vnt1), 1 To 1) As String
' Remarks: All arrays are of the same size.
' Loop through rows of arrays.
For i = 1 To NoR
' Write current value in 1st array to 1st String.
str1 = vnt1(i, 1)
' Write current value in 2nd array to 2nd String.
str2 = vnt2(i, 1)
' Check if 1st String is not empty ("").
If str1 <> "" Then ' 1st String is not empty.
' Check if 2nd String is not empty ("").
If str2 <> "" Then ' 2nd String is not empty.
' Concatenate.
strR = str1 & ", " & str2
Else ' 2nd String is empty.
strR = str1
End If
Else ' 1st String is empty.
If str2 <> "" Then ' 2nd String is not empty.
strR = str2
Else ' 2nd String is empty.
strR = ""
End If
End If
' Write Result String to current row of Result Array.
vntR(i, 1) = strR
Next
With ThisWorkbook.Worksheets("Raw_Data").Columns("AT")
' Copy Result Array to Result Range.
.Cells(2).Resize(NoR) = vntR
' Adjust the width of Result Column.
.AutoFit
' ' Apply some additional formatting to Result Range.
' With .Cells(2).Resize(NoR)
' ' e.g.
' .Font.Bold = True
' End With
End With
ProcedureExit:
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "An unexpected error has occurred. Error '" & Err.Number & "': " _
& Err.Description, vbInformation, "Error"
GoTo ProcedureExit
End Sub
Sub MergeLatLongRange() ' Range Version
Dim LastRow As Long ' Last Row Number
Dim i As Long ' Row Counter
Dim str1 As String ' 1st String
Dim str2 As String ' 2nd String
Dim strR As String ' Result String
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Handle possible error.
On Error GoTo ErrorHandler
With ThisWorkbook.Worksheets("Raw_Data")
' Insert column ("AT") to the right of column ("AS").
.Columns("AT").Insert xlToRight, xlFormatFromLeftOrAbove
' Calculate Last Used Row using 1st column "AR".
LastRow = .Cells(.Rows.Count, "AR").End(xlUp).Row
' Loop through rows in columns.
For i = 2 To LastRow
' Write value of cell at current row in column "AR" to 1st String.
str1 = .Cells(i, "AR")
' Write value of cell at current row in column "AS" to 2nd String.
str2 = .Cells(i, "AS")
' Check if 1st String is not empty ("").
If str1 <> "" Then ' 1st String is not empty.
' Check if 2nd String is not empty ("").
If str2 <> "" Then ' 2nd String is not empty.
' Concatenate.
strR = str1 & ", " & str2
Else ' 2nd String is empty.
strR = str1
End If
Else ' 1st String is empty.
If str2 <> "" Then ' 2nd String is not empty.
strR = str2
Else ' 2nd String is empty.
strR = ""
End If
End If
' Write Result String to cell at current row in column "AT".
Cells(i, "AT") = strR
Next
' Adjust the width of column "AT".
.Columns("AT").AutoFit
End With
ProcedureExit:
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
ErrorHandler:
MsgBox "An unexpected error has occurred. Error '" & Err.Number & "': " _
& Err.Description, vbInformation, "Error"
GoTo ProcedureExit
End Sub
答案 4 :(得分：0)
这是我最终使用的代码，上面的响应混合在一起。我创建了一些其他代码来查找具有纬度和经度的列，这样，如果以某种方式重新排列了列，则程序仍会在寻找正确的值列。
Sub concatenateLatLong()
Dim WS As Worksheet
Dim lastRow As Long
Dim longName As String
Dim longColumn As Long
Dim latName As String
Dim latColumn As Long
Dim latValue As String
Dim longValue As String
Dim i As Long
Set WS = Worksheets("Data")
With WS
lastRow = .Cells.Find(What:="*", After:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'MsgBox "The last row with entered data is " & lastRow
'Find Longitude column
longName = "LONGITUDE"
longColumn = .Rows(1).Find(What:=longName, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'MsgBox "The " & longName & " header is found in column " & longColumn
'Insert a row to the right of the longitude column
.Columns(longColumn + 1).Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeft
'Give new column header "LAT, LONG"
.Cells(1, longColumn + 1).Value = "LAT, LONG"
'Find Latitude column
latName = "LATITUDE"
latColumn = .Rows(1).Find(What:=latName, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'MsgBox "The " & latName & " header is found in column " & latColumn
'Combine latitude and longitude
For i = 2 To lastRow
latValue = Trim(.Cells(i, latColumn).Value)
longValue = Trim(.Cells(i, longColumn).Value)
If Len(longValue) Then longValue = ", " & longValue
If Len(latValue) And Len(longValue) > 0 Then latValue = latValue & longValue
.Cells(i, longColumn + 1).Value = latValue
Next i
End With
End Sub