Question

我想从A列中取值并将它们剪切并粘贴到B列中，每个值恰好是C列对应匹配值左侧的一个单元格。这是我想要的前后去完成。基本上，A列中的每个值在C列中找到它的匹配并被复制，然后直接粘贴到B列中匹配的左侧。

Column A      Column C
10               1
9                2
8                3
7                4
6                5
5                6
4                7
3                8
2                9
1                10

Column B       Column C
1                1
2                2
3                3
4                4
5                5
6                6
7                7
8                8
9                9
10               10

这是我尝试过的：

Sub arrange()
Cells(1, 1).Activate

Do

If IsEmpty(ActiveCell) Then Exit Do
If ActiveCell.Offset(0, 2).Value = ActiveCell.Value Then
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Activate
Else
ActiveCell.Offset(1, 0).Activate


End If

Loop

End Sub

这种方法的问题在于它只在同一行中找到匹配的值。我希望它能够搜索整个列并将值放在匹配旁边，无论匹配是否在同一行。

Answer 1

您需要做的是遍历A列并检查是否可以在C列中找到每个值。如果是复制到B列。

Sub arrange()

Dim Wbk As Workbook

Set Wbk = ActiveWorkbook

Dim row As Integer
Dim col As Integer
Dim currentA As Integer

Dim numRows As Integer

Worksheets("chicoexcel").Activate
numRows = Wbk.Worksheets("chicoexcel").Range("A2", Range("A2").End(xlDown)).Rows.Count

For a = 1 To numRows + 1 'start at 1 because it is the first row. This will loop through Column A

    currentA = Sheets("chicoexcel").Cells(a, "A").Value 'Save the current value in column A

    For c = 1 To numRows + 1 'start at 1 because it is the first row. This will loop through Column C

        If (Sheets("chicoexcel").Cells(c, "C").Value = currentA) Then 'Check if the col C value is equal to the current col A value.
            Sheets("chicoexcel").Cells(c, "B") = Sheets("chicoexcel").Cells(c, "C").Value  'If so copy to column B
            Sheets("chicoexcel").Cells(a, "A") = Null  'Remove the value from col A
        End If

    Next c

Next a


End Sub

我假设所有值都是整数，并且数据从第1行开始。

这不是最有效的解决方案，但您可以使用调试器查看发生的情况。您可以包含FIND功能以加快速度。我会让你自己解决这个问题。

使用VBA将匹配值放在另一列中匹配旁边的一列中

1 个答案: