[已解决]vba中合并的单元格如何选中

Quincy_xiao · 发表于 2022-8-9 09:38

本帖最后由 Quincy_xiao 于 2022-8-9 10:32 编辑

麻烦各位老师看看，附件中的三个地方需要怎么样实现，自己写过，选中合并的单元格时会出现问题。

最佳答案

我行我速2008

2022-8-9 09:38

本帖最后由我行我速2008 于 2022-8-9 11:47 编辑

认为行就选为最佳答案
Dim R%, I%, Str$, K%
Sub 依次获取D列合并单元格的值()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then
            I = .Cells(R, 4).MergeArea.Count
            MsgBox .Cells(R, 4).Text
            R = R + I - 1
         End If
      Next R
End With
End Sub
Sub 根据F列合并单元格获取I列对应数据()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
         If .Cells(R, 6).MergeCells Then
            I = .Cells(R, 6).MergeArea.Count
            For K = R To R + I - 1
                  If .Cells(K, 9) <> "" Then Str = Str & .Cells(K, 9) & ","
            Next K
            If Len(Str) > 0 Then
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据是：" & Str
            Else
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据为空"
            End If
            Str = ""
            R = R + I - 1
         End If
      Next R
End With
End Sub

Sub 选中D列所有合并单元格()
Dim R%, I%, Str$
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then
            I = .Cells(R, 4).MergeArea.Count
            Str = Str & .Cells(R, 4).Address(0, 0) & ","
            R = R + I - 1
         End If
      Next R
      .Range(Left(Str, Len(Str) - 1)).Select
End With
MsgBox Selection.Address
End Sub

跳转到最佳答案楼层

我行我速2008 · 发表于 2022-8-9 09:38

这个最佳答案由我行我速2008 给出，感谢我行我速2008 的回答。

单击隐藏图章

本帖最后由我行我速2008 于 2022-8-9 11:47 编辑

认为行就选为最佳答案
Dim R%, I%, Str$, K%
Sub 依次获取D列合并单元格的值()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then
            I = .Cells(R, 4).MergeArea.Count
            MsgBox .Cells(R, 4).Text
            R = R + I - 1
         End If
      Next R
End With
End Sub
Sub 根据F列合并单元格获取I列对应数据()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
         If .Cells(R, 6).MergeCells Then
            I = .Cells(R, 6).MergeArea.Count
            For K = R To R + I - 1
                  If .Cells(K, 9) <> "" Then Str = Str & .Cells(K, 9) & ","
            Next K
            If Len(Str) > 0 Then
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据是：" & Str
            Else
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据为空"
            End If
            Str = ""
            R = R + I - 1
         End If
      Next R
End With
End Sub

Sub 选中D列所有合并单元格()
Dim R%, I%, Str$
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then
            I = .Cells(R, 4).MergeArea.Count
            Str = Str & .Cells(R, 4).Address(0, 0) & ","
            R = R + I - 1
         End If
      Next R
      .Range(Left(Str, Len(Str) - 1)).Select
End With
MsgBox Selection.Address
End Sub

我行我速2008 · 发表于 2022-8-9 10:08

附件呢？？？？？？

Quincy_xiao · 发表于 2022-8-9 10:33

我行我速2008 发表于 2022-8-9 10:08
附件呢？？？？？？

老师好，我的错，明明上传了，切换悬赏后未点击使用。已更新

我行我速2008 · 发表于 2022-8-9 11:08

本帖最后由我行我速2008 于 2022-8-9 11:28 编辑

先写段依次选取D列合并单元格的代码。

Sub 依次选取D列合并单元格()
Dim R%, I%, Str$
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then I = .Cells(R, 4).MergeArea.Count
         R = R + I - 1
         .Cells(R, 4).Select
         MsgBox Selection.Address
      Next R
End With
End Sub

我行我速2008 · 发表于 2022-8-9 11:23

本帖最后由我行我速2008 于 2022-8-9 11:34 编辑

再来段：

Sub 根据F列合并单元格获取I列对应数据()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
         If .Cells(R, 6).MergeCells Then
            I = .Cells(R, 6).MergeArea.Count
            For K = R To R + I - 1
                  If .Cells(K, 9) <> "" Then Str = Str & .Cells(K, 9) & ","
            Next K
            If Len(Str) > 0 Then
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据是：" & Str
            Else
                  MsgBox .Cells(R, 6).Resize(I, 6).Address & "的I列对应数据为空"
            End If
            Str = ""
            R = R + I - 1
         End If
      Next R
End With
End Sub

我行我速2008 · 发表于 2022-8-9 11:28

这里的格子数会增加，怎么动态知道某个project有多个行

这个问题参见4楼的变量I

Quincy_xiao · 发表于 2022-8-9 11:33

我行我速2008 发表于 2022-8-9 11:08
先写段依次选取D列合并单元格的代码。

Sub 依次选取D列合并单元格()

那请问该如何获取合并的单元格里边的值呢？

我行我速2008 · 发表于 2022-8-9 11:36

Quincy_xiao 发表于 2022-8-9 11:33
那请问该如何获取合并的单元格里边的值呢？

Sub 依次获取D列合并单元格的值()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 4).End(xlUp).Row
         If .Cells(R, 4).MergeCells Then I = .Cells(R, 4).MergeArea.Count
         MsgBox .Cells(R, 4).Text
         R = R + I - 1
      Next R
End With
End Sub

Quincy_xiao · 发表于 2022-8-9 11:48

我行我速2008 发表于 2022-8-9 11:36
Sub 依次获取D列合并单元格的值()
With Sheets("project")
For R = 4 To .Cells(Rows.Coun ...

我将它改为了F列，存在了数组里
Sub GetFcolumn()
Dim R%, I%, Str$
Dim arr()
Dim arr1()
With Sheets("project")
      For R = 4 To .Cells(Rows.Count, 6).End(xlUp).Row
         ReDim Preserve arr(1 To .Cells(Rows.Count, 6).End(xlUp).Row + 3)
         If .Cells(R, 6).MergeCells Then
            I = .Cells(R, 6).MergeArea.Count
            arr(R) = .Cells(R, 6).Text
            R = R + I - 1
         Else
            .Cells(R, 6).Select
            arr(R) = .Cells(R, 6).Text
         End If
      Next R
End With
End Sub

现在我想将前面的循环放置，应该根据您的代码能够实现了，先拿到F列的内容行数x，然后放置x个project名称。

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