不用手工合并相同的单元格内容

dtmkzhb · 发表于 2024-11-6 17:39

不用手工合并相同的单元格内容

quqiyuan · 发表于 2024-11-6 18:38

这种只能vba啦

Excel_muke · 发表于 2024-11-6 18:53

Sub MergeFColumnIfGColumnIsSequential()
Dim ws As Worksheet
Set ws = ActiveSheet ' 设置当前活动工作表
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row ' 获取G列的最后一行
Dim startRow As Long
startRow = 2 ' 假设数据从第2行开始
Dim mergeStart As Long ' 用于记录开始合并的行
Dim i As Long
mergeStart = startRow
' 遍历G列的每一行
For i = startRow To lastRow
' 检查是否连续递增，且F列内容相同
If ws.Cells(i, "G").Value + 1 <> ws.Cells(i + 1, "G").Value Or _
ws.Cells(i, "F").Value <> ws.Cells(i + 1, "F").Value Then
' 判断是否需要合并F列单元格
If i > mergeStart Then
' 合并F列的相同内容单元格
With ws.Range("F" & mergeStart & ":F" & i)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
' 更新合并开始的行
mergeStart = i + 1
End If
Next i
' 处理最后一组
If lastRow > mergeStart Then
With ws.Range("F" & mergeStart & ":F" & lastRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
' 只在所有合并完成后弹出一次提示
MsgBox "所有符合条件的单元格已合并完成！", vbInformation
End Sub

复制代码

quqiyuan · 发表于 2024-11-6 18:54

代码如下。。。
Sub test()
Application.DisplayAlerts = False
Dim wb As Workbook, sht As Worksheet
Set wb = ThisWorkbook
Set sht = wb.Sheets("sheet1")
arr = sht.[a1].CurrentRegion
For i = 2 To UBound(arr)
      If arr(i, 1) = Empty Then
         arr(i, 1) = arr(i - 1, 1)
      End If
Next
   For i = UBound(arr) To 2 Step -1
      If arr(i, 6) = arr(i - 1, 6) And arr(i, 1) = arr(i - 1, 1) Then
         Range(Cells(i, 6), Cells(i - 1, 6)).Merge
      End If
Next
Beep
Application.DisplayAlerts = True
End Sub

Excel_muke · 发表于 2024-11-6 18:54

Sub MergeFColumnIfGColumnIsSequential()
Dim ws As Worksheet
Set ws = ActiveSheet ' 设置当前活动工作表
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row ' 获取G列的最后一行
Dim startRow As Long
startRow = 2 ' 假设数据从第2行开始
Dim mergeStart As Long ' 用于记录开始合并的行
Dim i As Long
mergeStart = startRow
' 遍历G列的每一行
For i = startRow To lastRow
' 检查是否连续递增，且F列内容相同
If ws.Cells(i, "G").Value + 1 <> ws.Cells(i + 1, "G").Value Or _
ws.Cells(i, "F").Value <> ws.Cells(i + 1, "F").Value Then
' 判断是否需要合并F列单元格
If i > mergeStart Then
' 合并F列的相同内容单元格
With ws.Range("F" & mergeStart & ":F" & i)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
' 更新合并开始的行
mergeStart = i + 1
End If
Next i
' 处理最后一组
If lastRow > mergeStart Then
With ws.Range("F" & mergeStart & ":F" & lastRow)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
' 只在所有合并完成后弹出一次提示
MsgBox "所有符合条件的单元格已合并完成！", vbInformation
End Sub

复制代码

quqiyuan · 发表于 2024-11-6 18:55

仅供参考。。。

xlj310 · 发表于 2024-11-6 19:05

quqiyuan 发表于 2024-11-6 18:38
这种只能vba啦

也未必就一定要VBA，看用的版本是咋样的。如果是wps专业版或者个人版开了会员的话，这个功能是自带的。

quqiyuan · 发表于 2024-11-6 19:08

xlj310 发表于 2024-11-6 19:05
也未必就一定要VBA，看用的版本是咋样的。如果是wps专业版或者个人版开了会员的话，这个功能是自带的。

没有WPS ，所以不知道，他这个情况还有前面的条件的，不是相同就合并的，还要看姓名的，vba 也简单，几行代码OK了

ykcbf1100 · 发表于 2024-11-6 20:35

参与一下，直接在F列合并。

ykcbf1100 · 发表于 2024-11-6 20:36

参与一下。。。

		自动登录	找回密码
密码			免费注册

不用手工合并相同的单元格内容

评分