需要代碼才能檢查當前列和另一列，並匹配使用相同的訂單號

Question

如果您看到下面，我有3列，我基本上想要檢查列A和列B，如果承運人（A列）和日期（B列）相等，那麼它將具有相同的訂單號。

例如：在這種情況下，A3 = A6和B3 = B6，所以它應該具有與上面（160）而不是163相同的訂單號。我希望這說明清楚。

感謝您的幫助。我很欣賞它:)

Answer 1

這很有趣，所以我繼續寫下一些代碼。將其複製到新模塊中並更改工作表名稱等以適合您的工作簿。您可能還需要重新定義fr（第一行，當前設置爲2）。該代碼目前還將所有更改的訂單號標記爲.Range("C" & r).Font.ColorIndex = 3。刪除/評論它，如果你不想要的話。

Sub matching() 

Dim wb As Workbook 
Dim tws As Worksheet 

Dim keys() As String 
Dim tmpKey As String 
Dim pos As Integer 

Dim fr, lr As Integer   'first row, last row of data 


    Set wb = ThisWorkbook 

    Set tws = wb.Worksheets("Vigmo") 

    fr = 2 

    lr = tws.Range("A1000000").End(xlUp).Row 


    ReDim keys(1 To lr - 1) 

    With tws 
     keys(1) = .Range("A" & fr).Value & "_" & .Range("B" & fr).Value 
    End With 

    For r = fr + 1 To lr 

     With tws 

      tmpKey = .Range("A" & r).Value & "_" & .Range("B" & r).Value 

      If UBound(Filter(keys, tmpKey)) >= 0 And tmpKey <> "_" Then 
       'found in array -> replace orderNumber 
       'On Error resume next 
       pos = Application.Match(tmpKey, keys, 0) 
       'On Error goto 0 

       .Range("C" & r).Value = .Range("C" & pos + 1).Value 
       .Range("C" & r).Font.ColorIndex = 3 
      Else 
       'not found -> next 
      End If 

      keys(r - 1) = tmpKey 


     End With 

    Next r 


End Sub 

讓我知道如果您有任何問題，這個代碼的工作原理！

Answer 2

下面是我想出的一些代碼，它可以滿足您的需求。我不知道你是如何生成你的訂單號碼，但我認爲他們已經存在。希望這可以幫助你:)

Sub OrderNumber() 

Dim SearchTerm As String 
Dim DateTerm As Date 
Dim NumberOfEntries As Long 
Dim wks As Excel.Worksheet 

Set wks = Worksheets("Sheet1") '<==== Sets the workbook. change it to what yours is called 

NumberOfEntries = Application.WorksheetFunction.CountA(wks.Range("A:A")) '<=== Find the number of entries 

For x = 2 To NumberOfEntries '<==== Goes through all the entries 
    SearchTerm = wks.Cells(x, 1) '<===== The Search term (Carrier) 
    DateTerm = CDate(wks.Cells(x, 2)) '<==== The search Date 
    For y = x To NumberOfEntries '<===== goes through everything below the search term to speed things up 
     If wks.Cells(y, 1) = SearchTerm And CDate(wks.Cells(y, 2)) = DateTerm Then '<=== If the name and the date match then 
      wks.Cells(y, 3) = wks.Cells(x, 3) '<==== Copy the order number 
     End If 
    Next y 
Next x 

End Sub 

只要把它放在一個模塊或任何你想要的地方，但我把它放在一個模塊中。

摹