Question

我在编写宏时遇到了一些麻烦。我试图在列A和列D中找到匹配。当我检测到匹配时，我想将每个IE的相邻单元复制到第一个匹配行的B的内容到E，其中匹配发生在D.每当我这样做，我从来没有得到正确的副本。它将复制匹配的值，但将它们放在完全错误的空间中。我只在订单混淆或有空白时遇到问题。任何建议都会有所帮助。

由于

尼克。

注意：在我的代码版本中，我使用输入框来选择用户想要比较的两列数据以及他想要复制的数据列并粘贴。它不应该有很大的不同。

Sub Copy()
Dim column1 As String
Dim column2 As String
Dim from As String
Dim too As String

numrows = Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row

'MsgBox numrows

column1 = InputBox("which column do you want to select from")
column2 = InputBox("which column do you want to compare to ")
from = InputBox("which column do you want to copy data from")
too = InputBox("which column do you want to copy data to")

Dim lngLastRow As Long
Dim lngLoopCtr As Long
Dim i As Long
Dim j As Long
Dim value As String

lngLastRow = Range(column1 & Rows.Count).End(xlUp).Row
lngLastRow2 = Range(column2 & Rows.Count).End(xlUp).Row
'lngLastRow = Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
Dim temp As String

For i = 1 To lngLastRow Step 1
    temp = Cells(i, column1).value
    value = Cells(i, from).value
    'MsgBox "temp"
    'MsgBox (temp) 

    If Cells(i, column1).value <> "" Then
        For j = 1 To lngLastRow2 Step 1    
            ' MsgBox "cell"
            ' MsgBox (Cells(j, column2).value)

            If Cells(j, column2).value = "" Then
                Cells(j, column2).Offset(1, 0).Select
            End If

            If Cells(j, column2).value <> "" Then
                If temp = Cells(j, column2).value Then
                'MsgBox "equal"
                'MsgBox "i"
                'MsgBox i
                'MsgBox "j"
                'MsgBox j
                'value = Cells(j, from).value
                'MsgBox Cells(i, too).value
                'Cells(i, too).value = Cells(j, from).value 
                'Dim num As Integer
                'On Error Resume Next
                'num = Application.WorksheetFunction.VLookup(temp, Sheet1.Range("A0:M13"), 3, False)

                     Cells(i, too).value = Cells(j, from).value
                'MsgBox j
                ' MsgBox (Cells(i, column1).value)
                ' MsgBox "="
                ' MsgBox (Cells(j, column2).value)
                End If
            End If
        Next j
    End If
Next i
End Sub

Answer 1

我已经研究了你的文字和你的宏，并认为下面的宏做你想要的。

如果此宏执行您想要的操作，则问题是由于您使用无意义的变量名称引起的，例如：column1，column2，i和j。这意味着您没有注意到您在复制值的语句中使用了错误的变量。

我已经重命名了所有变量。我不是要求你喜欢我的命名约定，但我建议你有一个命名约定。我可以看看我多年前写过的宏，并知道所有变量是什么，因为我在VBA编程的早期开发了我的约定并且从那以后一直使用它。当我需要更新旧宏时，这使我的生活更加轻松。

我在模块顶部添加了Option Explicit。如果没有此语句，拼写错误的变量名称将成为声明：

Dim Count As Long

Lots of statements

Count = Conut + 1

这会导致Conut声明为零。这些错误可能是一个噩梦。

我使用了With语句来明确我正在使用的工作表。

您检查了两个单元格是否为空。我只检查第一个，因为没有必要检查第二个，因为如果第二个是空的，它将与第一个不匹配。

如果找到匹配项，那么您的代码并没有停止在Compare列中运行，因此我的代码也是如此。如果值可以在“比较”列中重复，则这是正确的。如果它们无法重复，您可能希望在处理完匹配后添加Exit For以退出内循环。

我相信以上解释了我所做的所有改变。

Option Explicit
Sub Copy()

  Dim ColCompare As String
  Dim ColCopyFrom As String
  Dim ColCopyTo As String
  Dim ColSelect As String
  Dim RowCrntCompare As Long
  Dim RowCrntSelect As Long
  Dim RowLastColCompare As Long
  Dim RowLastColSelect As Long
  Dim SelectValue As String

  With Sheet1

    ColSelect = InputBox("which column do you want to select ColCopyFrom")
    ColCompare = InputBox("which column do you want to compare to ")
    ColCopyFrom = InputBox("which column do you want to copy data ColCopyFrom")
    ColCopyTo = InputBox("which column do you want to copy data to")

    RowLastColSelect = .Range(ColSelect & .Rows.Count).End(xlUp).Row
    RowLastColCompare = .Range(ColCompare & .Rows.Count).End(xlUp).Row

    For RowCrntSelect = 1 To RowLastColSelect Step 1
      SelectValue = .Cells(RowCrntSelect, ColSelect).value
      If SelectValue <> "" Then
        For RowCrntCompare = 1 To RowLastColCompare Step 1
          If SelectValue = Cells(RowCrntCompare, ColCompare).value Then
            .Cells(RowCrntCompare, ColCopyTo).value = _
                                           .Cells(RowCrntSelect, ColCopyFrom).value
          End If
        Next RowCrntCompare
      End If
    Next RowCrntSelect

  End With

End Sub

比较和复制相邻单元格的匹配数据

1 个答案: