比較並復制相鄰單元格中的匹配數據

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語句來明確說明我正在使用哪個工作表。

您檢查了兩個單元格都不為空。 我只檢查第一個，因為沒有必要檢查第二個，因為如果第二個為空，則它將不匹配第一個。

如果找到匹配項，您的代碼不會停止對“比較”列進行處理，因此我的代碼也是如此。 如果值可以在“比較”列中重復，這是正確的。 如果它們無法重復，則您可能希望添加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