Question

我有两列数据：

Column A有多个粗体字体，代表英文段落的标题，
Column B与Column A具有相同的粗体标题，但使用的语言不同。

问题：

Column A中的粗体细胞及Column B中的等效细胞不会出现在同一行中。我想要的是对齐/匹配两者，知道它们的等价物可能在给定单元格之前或之后显示一行。

以下是我的数据示例（Column A和Column B是原始数据，Column E和Column F是我所追求的内容：

这是我的代码：

Sub AlignTwoColumns()
'*same number of headers in each column is a must

Dim i As Integer
Dim j As Integer
Dim C1PI As Integer 'column 1 position indicator = C1PI
                    'C1PI is used to locate the position of found bold cell in column 1 
Dim C2PI As Integer 'column 2 position indicator = C2PI
                    'C1PI is used to locate the position of found bold cell in column 2 
Dim C2SSI As Integer 'column 2 search starting indicator 
                     'once we find a bold cell in column 2 or 1 we 
                     'start our next search one from the next position of 
                     'the current found position thus we use C2ssI 
Dim C1SSI As Integer

Dim LastRow1 As Integer 'the last cell in coulmn 1
Dim LastRow2 As Integer 'the last cell in coulmn 2

With ActiveSheet
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

C1SSI = 1
C2SSI = 1
C1PI = 1
C2PI = 1

For i = C1SSI To LastRow1
    If Range("A" & i).Font.Bold Then
    C1PI = i
        For j = C2SSI To LastRow2
            If Range("B" & j).Font.Bold Then
            C2PI = j
                If C1PI > C2PI Then
                     'cut cells in column 2 from C2PI to LastRow2
                     'paste cut cells in column 2 at position C1PI
                      Range("B" & C2PI & ":" & "B" & LastRow2).Select
                      Selection.Cut
                      Range("B" & C1PI).Select
                      ActiveSheet.Paste
                      'update the indicators 
                      C1SSI = C1PI + 1
                      C2SSI = C1PI + 1

                      With ActiveSheet 'update last cell position after copy and paste
                            LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                            LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
                      End With

                      i = C1SSI
                      j = C2SSI

                      Exit For
                ElseIf C1PI < C2PI Then
                     'cut cells in column 1 from C1PI to LastRow1
                     'paste cut cells in column 1 at position C2PI
                      Range("A" & C1PI & ":" & "A" & LastRow1).Select
                      Selection.Cut
                      Range("A" & C2PI).Select
                      ActiveSheet.Paste

                      C2SSI = C2PI + 1
                      C1SSI = C2PI + 1

                      With ActiveSheet 'update last cell position after copy and paste
                            LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                            LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
                      End With

                      j = C2SSI
                      i = C1SSI

                      Exit For
                Else
                    'do nothing
                     With ActiveSheet 'update last cell position after copy and paste
                            LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                            LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
                     End With

                End If

            End If
        Next j
    End If
'the last i is not updating???!

Next i
End Sub

代码运行良好，但在最终i值更新之前退出。

对于我做错的任何帮助都将不胜感激。

Answer 1

这是最终的代码

Sub AlignTwoColumns2()

Dim i As Integer
Dim j As Integer
Dim C1PI As Integer 'column 1 position indicator = C1PI
Dim C2PI As Integer 'column 2 position indicator = C2PI
Dim C2SSI As Integer 'column 2 search starting indicator = C2SI
Dim C1SSI As Integer
Dim LastRow1 As Integer 'last cell in column 1
Dim LastRow2 As Integer 'last cell in column 2

With ActiveSheet
LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
End With

C1SSI = 1
C2SSI = 1
C1PI = 1
C2PI = 1

i = 1
Do Until i > LastRow1
    If Range("A" & i).Font.Bold Then
    C1PI = i
        For j = C2SSI To LastRow2
            If Range("B" & j).Font.Bold Then
            C2PI = j
                If C1PI > C2PI Then
                     'cut cells in column 2 from C2PI to LastRow2
                     'paste cut cells in column 2 at position C1PI
                      Range("B" & C2PI & ":" & "B" & LastRow2).Select
                      Selection.Cut
                      Range("B" & C1PI).Select
                      ActiveSheet.Paste

                      C2SSI = C1PI + 1
                      j = C2SSI

                      With ActiveSheet 'update last cell position after copy and paste
                            LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                            LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
                      End With

                      Exit For
                ElseIf C1PI < C2PI Then
                     'cut cells in column 1 from C1PI to LastRow1
                     'paste cut cells in column 1 at position C2PI
                      Range("A" & C1PI & ":" & "A" & LastRow1).Select
                      Selection.Cut
                      Range("A" & C2PI).Select
                      ActiveSheet.Paste

                  C2SSI = C2PI + 1
                  i = C2SSI
                  j = C2SSI

                  With ActiveSheet 'update last cell position after copy and paste
                        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
                        LastRow2 = .Cells(.Rows.Count, "B").End(xlUp).Row
                  End With

                  Exit For
            Else
                'do nothing if they are equal (aligned)
                C1PI = i
                C2PI = j
                C2SSI = C2PI + 1
                j = C2SSI
                Exit For
            End If
        End If
    Next j
End If
i = i + 1 'increase the outer loop index
Loop
End Sub

匹配两列相似数据并放在两列但在同一行中

1 个答案: