Excel VBA：合并循环内的范围

问题描述：

这是我的代码如何循环。

 Dim label As Control 
     Dim itm As Object 
     For ctr = 1 To InfoForm.Chapter.ListCount - 1 
      For Each label In InfoForm.Controls 
       If TypeName(label) = "Label" Then 
        With ActiveSheet 
         i = i + 1 

         lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + IIf(i = 1, 1, 0) 
         lastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column 

         If label <> "Chapter" Then 
          .Cells(lastColumn, i).Value = "Chapter " & ctr 

          .Cells(lastRow, i).Value = label.Caption 
         End If 
        End With 
       End If 
      Next 
     Next

我试图合并它像这样

.Range(Cells(1, lastColumn), Cells(1,i)).Merge

不过它把所有重复的章节为一个单元，而不是

预期结果：

你能提供预期输出的例子吗？ – MiguelH

这是我的预期结果 –

我发现有关表单控件的代码有点混乱......你只是试图合并一堆保持相同值的单元格，不是吗？ –

答

我的方法是波纹管

Dim label As Control 
    Dim itm As Object 
    For ctr = 1 To InfoForm.Chapter.ListCount - 1 
     For Each label In InfoForm.Controls 
      If TypeName(label) = "Label" Then 
       With ActiveSheet 
        i = i + 1 

        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + IIf(i = 1, 1, 0) 
        lastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column 

        If label <> "Chapter" Then 
         .Cells(lastColumn, i).Value = "Chapter " & ctr 

         .Cells(lastRow, i).Value = label.Caption 
        End If 
       End With 
      End If 
     Next 
    Next 

    'this is merge method 
    Dim rngDB As Range, rng As Range, n As Integer 

    Application.DisplayAlerts = False 
    Set rngDB = Range("a1", Cells(1, Columns.Count).End(xlToLeft)) 
    For Each rng In rngDB 
     If rng <> "" Then 
      n = WorksheetFunction.CountIf(rngDB, rng) 
      rng.Resize(1, n).Merge 
      rng.HorizontalAlignment = xlCenter 
     End If 
    Next rng 
    Application.DisplayAlerts = True

这有效。非常感谢。 –

Hi @ Dy.Lee，如果你可以，你可以问一下你的代码的解释。我的意思是发生了什么，它是如何工作的。 –

@HydesYase：代码原理非常简单。当单元格合并时，单元格为空。因此，具有相同值的其他单元是空单元，也就是第一单元。合并方法应用于第一个单元格（如果rng “”）。在该范围内，您可以通过worksheetfunctoion.countif来计算具有相同值的单元格。您可以合并通过调整大小（行，列）方法计算的单元格。 –

答

如果你知道然后你可以调整下面的代码。我已经通过录制宏创建了这个功能，然后根据需要禁用/启用警报。我已经包含了一个函数来将整数列值转换为alph等值。MainLoopIntcol1和intcol2应该是基于来自原始表单的输入提供的值。

Sub MainLoop() 
Dim StrMycol_1 As String 
Dim StrMycol_2 As String 
Dim intcol1 As Integer 
Dim intcol2 As Integer 

    intcol1 = 5: intcol2 = 7 

    StrMycol_1 = WColNm(intcol1) ' mycell.column is numeric. Function returns integer 
    StrMycol_2 = WColNm(intcol2) ' mycell.column is numeric. Function returns integer 
' 
    do_merge_centre StrMycol_1, StrMycol_2 
End Sub 

Sub do_merge_centre(col1, col2) 
Range(col1 + "1:" + col2 + "1").Select 
Application.DisplayAlerts = False 
With Selection 
    .HorizontalAlignment = xlCenter 
    .VerticalAlignment = xlBottom 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = False 
End With 
Selection.Merge 
Application.DisplayAlerts = True 
End Sub 
' 
Public Function WColNm(ColNum) As String 
    WColNm = Split(Cells(1, ColNum).Address, "$")(1) 
End Function

我有一个用户表单，我正在循环其中的控件来确定范围。将来，我可能想要为该用户表单添加更多控件，并且我认为如果每次都必须更改范围，可能会很麻烦。这就是为什么我要循环控制，以便它自动执行此操作。 –

那么如果你知道有多少次重复，那么你可以将上面的代码作为一个子程序，并传入所需的范围值（即将列号更改为等效的字母字符） – MiguelH

@HydesYase。查看将数字列转换为alpha列范围的更新答案 – MiguelH

答

这个怎么样？

With ActiveSheet 
    firstCol = 1 
    lastCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column 
    For i = 1 To lastCol 
    If .Cells(1, i) = "" Then GoTo NextCol 'skip blank cell 

    If firstCol = 0 And .Cells(1, i) <> "" Then firstCol = i 'set first column 

    If .Cells(1, i) = .Cells(1, i + 1) Then 
     LastColDup = i 'remember last duplicate column 
    Else 
     Application.DisplayAlerts = False 
     With .Range(Cells(1, firstCol), Cells(1, LastColDup + 1)) 
      .Merge 
      .HorizontalAlignment = xlCenter 
     End With 
     Application.DisplayAlerts = True 
     firstCol = 0 
     LastColDup = 0 
    End If 
NextCol: 
    Next i 
End With

Excel VBA：合并循环内的范围

相关推荐