Question

100         300
200         500
300         700
800         400
500         200 
600         100

我想取两列数字（A列和C列）并排列它们，以便匹配放在同一行中，同时保留在各自的列中。两列都将按升序排列。如果另一列中没有匹配值，我希望那里有一个空格。以下是运行宏后列的外观：

100         100
200         200  
300         300
            400
500         500
600
            700
800

我知道我需要设置一个循环让它在列中运行，如果在另一列中找到匹配项，则将匹配值向上或向下移动到其各自匹配的行。它将是这样的，从活动单元格开始，作为＆＃34; A1＆＃34;，A列中的第一个单元格：

If Not ActiveCell.Value = ActiveCell.Offset(0,2) Then

然后让它在列C中找到匹配值，然后将其剪切并粘贴到与活动单元格相同的行中，或者如果没有匹配值，则在活动单元格的行中的列C中留一个空格在C栏中。

我的问题是，如何在循环中设置If-Then语句以使此宏以我需要的方式运行？

Answer 1

看起来不是很直接，所以试一试。试试这个代码。数据在col A和B

中

Sub Macro2()
    Range("A1:A6").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:A6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:A6")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("B1:B6").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B1:B6")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    lr1 = Range("A" & Rows.Count).End(xlUp).Row
    lr2 = Range("B" & Rows.Count).End(xlUp).Row
    lr = WorksheetFunction.Min(lr1, lr2)
    i = 1

    Do While (i <= lr)
        a = Range("A" & i)
        b = Range("B" & i)

        If Not (a = b) Then
            If (Range("A" & i) > Range("B" & i)) Then
                Range("A" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Else
                Range("B" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If

        End If
        i = i + 1
        lr1 = Range("A" & Rows.Count).End(xlUp).Row
        lr2 = Range("B" & Rows.Count).End(xlUp).Row
        lr = WorksheetFunction.Min(lr1, lr2)
    Loop
End Sub

Answer 2

你可以试试这个：

Option Explicit

Sub Main()
    With Worksheets("numbers") '<--| change "numbers" to your actual worksheet name
        With Intersect(.Range("A1").Resize(, 2).EntireColumn, .UsedRange)
            .Offset(, .Columns.Count).Resize(, 1).Value = .Columns(1).Value
            .Offset(.Rows.Count, .Columns.Count).Resize(, 1).Value = .Columns(2).Value
            With .Offset(, .Columns.Count).Resize(2 * .Rows.Count, 1)
                .RemoveDuplicates Columns:=1, Header:=xlNo
                .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
                Order .Offset(, -2).Resize(.Rows.Count / 2), .Parent.Range(.Range("A1"), .Range("A1").End(xlDown))
                Order .Offset(, -1).Resize(.Rows.Count / 2), .Parent.Range(.Range("A1"), .Range("A1").End(xlDown))
                .ClearContents
            End With
        End With
    End With
End Sub

Sub Order(rngToOrder As Range, sortingRng As Range)
    Dim cell As Range
    ReDim arr(1 To sortingRng.Rows.Count)

    For Each cell In rngToOrder
        arr(sortingRng.Find(cell.Value, LookIn:=xlValues, lookat:=xlWhole).Row) = cell.Value
    Next cell
    rngToOrder.Resize(sortingRng.Rows.Count).Value = Application.Transpose(arr)
End Sub

循环以在列中排列匹配值，在没有匹配时将单元格留空

2 个答案: