Excel比較在不同的工作表和不匹配/不匹配的結果中的兩個工作表應該存儲在其他方面

3

我會好心的，假設你不知道從哪裏開始。我們有時會建議人們嘗試使用宏記錄器來首先了解他們需要的代碼。不幸的是，你的問題不是宏記錄器可以幫助的問題。

比較這樣的兩個列表並不是最容易出現的第一個問題。我試圖通過一些小步驟來完成，所以你可以理解它們。麻煩的是有幾種可能的情況，每種情況都必須進行測試和實施：

Sheet1中的值而不是Sheet2中的值。從Sheet1獲取新值。
Sheet2中的值，但不是Sheet1中的值。記錄不匹配。從Sheet2獲取新的價值。
值匹配。從Sheet1和Sheet2中獲取新值。
Sheet1在Sheet2之前耗盡了數值。將Sheet2中的所有剩餘值記錄爲不匹配。
Sheet2已經用完了數值。完。

我已經解釋了所有的步驟，但我相信你將需要使用F8來逐步下降代碼一條語句。如果你將鼠標懸停在一個變量上，你可以看到它的值。

問你是否不明白，但先嚐試F8。我不會回答問題，除非你告訴我你已經嘗試了什麼以及出了什麼問題。

Option Explicit   ' This means I cannot use a variable I have not declared 
Sub Compare() 

    ' Declare all the variables I need 
    Dim Row1Crnt As Long 
    Dim Row2Crnt As Long 
    Dim Row3Crnt As Long 
    Dim Row1Last As Long 
    Dim Row2Last As Long 

    Dim ValueSheet1 As Long 
    Dim ValueSheet2 As Long 

    Dim NeedNewValueSheet1 As Boolean 
    Dim NeedNewValueSheet2 As Boolean 

    With Sheets("Sheet1") 
    ' This goes to the bottom on column D, then go up until a value is found 
    ' So this finds the last value in column D 
    Row1Last = .Cells(Rows.Count, "D").End(xlUp).Row 
    End With 
    ' I assume Row 1 is for headings and the first data row is 2 
    Row1Crnt = 2 

    With Sheets("Sheet2") 
    Row2Last = .Cells(Rows.Count, "F").End(xlUp).Row 
    End With 
    Row2Crnt = 2 

    ' You do not say which column to use in Sheet 3 so I assume "H". 
    ' You do not same in the column in Sheet 3 is empty so I place 
    ' the values under any existing value 
    With Sheets("Sheet3") 
    Row3Crnt = .Cells(Rows.Count, "H").End(xlUp).Row 
    End With 
    Row3Crnt = Row3Crnt + 1 ' The first row under any existing values in column H 

    ' In Sheet1, values are on rows Row1Crnt to Row1Last 
    ' In Sheet2, values are on rows Row2Crnt to Row2Last 
    ' In Sheet3, non-matching values are to be written to Row3Crnt and down 

    ' In your questions, all the values are numeric and are in ascending order. 
    ' This code assumes this is true for the real data. 

    ' Load first values. This will give an error if the values are not numeric. 
    ' If the values are decimal, the decimal part will be lost. 
    With Sheets("Sheet1") 
     ValueSheet1 = .Cells(Row1Crnt, "D").Value 
    End With 
    With Sheets("Sheet2") 
     ValueSheet2 = .Cells(Row2Crnt, "F").Value 
    End With 

    ' Loop for ever. Code inside the loop must decide when to exit 
    Do While True 
    ' Test for each of the possible situations. 
    If Row1Crnt > Row1Last Then 
     ' There are no more values in Sheet1. All remaining values in 
     ' Sheet2 have no match 
     With Sheets("Sheet3") 
     .Cells(Row3Crnt, "H").Value = ValueSheet2 
     Row3Crnt = Row3Crnt + 1 
     End With 
     'I need a new value from Sheet2 
     NeedNewValueSheet2 = True 
    ElseIf ValueSheet1 = ValueSheet2 Then 
     ' The two values are the same. Neither are required again. 
     ' Record I need new values from both sheets. 
     NeedNewValueSheet1 = True 
     NeedNewValueSheet2 = True 
    ElseIf ValueSheet1 < ValueSheet2 Then 
     ' Have value in Sheet1 that is not in Sheet2. 
     ' In the example in your question you do not record such values 
     ' in Sheet3. That is, you do not record 1, 2, 3 and 4 which are 
     ' in Sheet1 but not Sheet3. I have done the same. 
     'I need a new value from Sheet1 but not Sheet2 
     NeedNewValueSheet1 = True 
     NeedNewValueSheet2 = False 
    Else 
     ' Have value in Sheet2 that is not in Sheet1. 
     ' Record in Sheet3 
     With Sheets("Sheet3") 
     .Cells(Row3Crnt, "H").Value = ValueSheet2 
     Row3Crnt = Row3Crnt + 1 
     End With 
     'I need a new value from Sheet2 but not Sheet1 
     NeedNewValueSheet1 = False 
     NeedNewValueSheet2 = True 
    End If 
    ' I have compared the two values and if a non match was found 
    ' it has been recorded. 

    ' Load new values as required 
    If NeedNewValueSheet1 Then 
     ' I need a new value from Sheet1 
     Row1Crnt = Row1Crnt + 1 
     If Row1Crnt > Row1Last Then 
     ' There are no more in Sheet1. Any remaining values 
     ' in Sheet2 are not matched. 
     Else 
     With Sheets("Sheet1") 
     ValueSheet1 = .Cells(Row1Crnt, "D").Value 
     End With 
     End If 
    End If 

    If NeedNewValueSheet2 Then 
     ' I need a new value from Sheet2 
     Row2Crnt = Row2Crnt + 1 
     If Row2Crnt > Row2Last Then 
     ' There are no more in Sheet2. Any remaining 
     ' values in Sheet1 are ignored 
     Exit Do 
     End If 
     With Sheets("Sheet2") 
     ValueSheet2 = .Cells(Row2Crnt, "F").Value 
     End With 
    End If 
    Loop 

End Sub

響應新條文，改爲原來的問題

我不明白你正在嘗試做的，我相信你一定已經更改了我的原代碼。我在下面解釋與您的要求相關的陳述。你應該能夠結合他們來創建你想要的例程。

1期

你說現在列C是你希望使用的比較列。你也可以說行不是按我的代碼假設的升序排列的。顯而易見的解決方案是通過柱的工作表進行排序C.

我通過創建以下代碼：

接通宏錄製器。
選擇Sheet1的全部，說我有一個標題行並按列C對它排序。
關閉宏記錄器。

使用宏記錄器是發現如何做某事的最簡單的方法，但代碼需要一些調整。由宏錄製保存的代碼是：

Cells.Select 
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal

我做如下修改：

添加With Sheets("Sheet1")此代碼之前和End With之後。保存的代碼對活動工作表進行排序。我的更改表明我想對Sheet1進行排序，無論哪個表處於活動狀態。
通過刪除.Select Selection合併兩條語句。我不想選擇要排序的範圍，因爲這會降低宏。
在Cells和Range之前加點。這將它們鏈接到With Statement。
最後我用Header:=xlYes代替Header:=xlGuess。

結果是：

With Sheets("Sheet1") 
    .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 
End With

從VBA編輯器中選擇幫助和搜索「排序方法」。你會得到幾個結果，其中一個將是「排序方法」。這將解釋所有其他參數。但是，你可能不需要。如果您按照您的要求對Sheet1進行了排序，則其他參數將根據您的需要進行排序。

製作副本，並與Sheet2的工作表Sheet1替換給：只是在最後的昏暗statments的

With Sheets("Sheet1") 
    .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 
End With 
With Sheets("Sheet2") 
    .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _ 
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ 
     DataOption1:=xlSortNormal 
End With

將這些新代碼。

第2期

本來你想使用的列d在Sheet1和F列於表2。現在要使用C列在這兩個表。

用"C"替代所有對"D"和"F"的引用。

3期

你現在要17列從Sheet2中複製到Sheet。你不會說要複製Sheet2中的哪17列或者Sheet3中的哪17列要接收17列。在下面的代碼中，我假設你想將列A到Q複製到從列B開始的17列。你應該很容易地改變到你需要的列。

替換：

With Sheets("Sheet3") 
    .Cells(Row3Crnt, "H").Value = ValueSheet2 
    Row3Crnt = Row3Crnt + 1 
End With

通過

With Sheets("Sheet3") 
    Worksheets("Sheet2").Range("A" & Row2Crnt & ":Q" & Row2Crnt).Copy _ 
           Destination:=.Range("B" & Row3Crnt) 
    Row3Crnt = Row3Crnt + 1 
End With

摘要

我覺得這些都是你需要修改我原來的程序來獲得您所需要的日常的語句。

來源

2012-02-11 23:25:46

+0

謝謝託尼，上面的代碼工作得很好，但我想以更簡單的方式解釋它。 1.工作表1和工作表2中的項目未按排序順序排列。 2. sheet1＆Sheet2中的項目是文本格式。 3. sheet1＆Sheet2包含17（R）列。現在我想比較兩張表的'c'欄中的項目。 5.最終結果應該**包含在工作表2中而不是工作表1中的項目** 6.工作表1包含一些項目，工作表2包含工作表1中的所有項目以及包含該項目的所有項目。 7.最後我想在sheet3中得到結果。請幫助我以上。 – neobee 2012-02-15 20:31:41

+0

謝謝Tony，上面的代碼甚至對於文本格式都運行良好。需要一個小修改。如上所述，工作表1和工作表2包含17列。現在sheet3還應該包含17列。對於上面的代碼，只有列H顯示。 PLease發佈顯示全部17列的代碼。在此先感謝 – neobee 2012-02-15 22:34:40

+0

問題。（1）Sheet1和Sheet2可以按宏排序嗎？（2）如果它們不能被排序，它們是否嚴重失序？（3）您想比較Sheet1的C列和Sheet2的C列。這是不是列D和F.（4）你想從Sheet2移動哪17列？（5）Sheet3中的哪些列要接收17列？ – 2012-02-16 00:15:25

0

使用ADO和Excel可以做很多事情。它對比較特別有用。

Dim cn As Object 
Dim rs As Object 
Dim strFile As String 
Dim strCon As String 
Dim strSQL As String 
Dim s As String 
Dim i As Integer, j As Integer 

''This is not the best way to refer to the workbook 
''you want, but it is very convenient for notes 
''It is probably best to use the name of the workbook. 

strFile = ActiveWorkbook.FullName 

''Note that if HDR=No, F1,F2 etc are used for column names, 
''if HDR=Yes, the names in the first row of the range 
''can be used. 
'' 
''This is the ACE connection string, you can get more 
''here : http://www.connectionstrings.com/excel 

strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=No"";" 

''Late binding, so no reference is needed 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 

''In sheet2 but not in sheet1, all the SQL that can be used 
''in ACE can be used here, JOINS, UNIONs and so on 
strSQL = "SELECT a.F1,b.F1 FROM [Sheet2$] a " _ 
     & "LEFT JOIN [Sheet1$] b On a.F1=b.F1 " _ 
     & "WHERE b.F1 Is Null" 

rs.Open strSQL, cn, 3, 3 


''Pick a suitable empty worksheet for the results 

Worksheets("Sheet3").Cells(1, 1).CopyFromRecordset rs 

''Tidy up 
rs.Close 
Set rs = Nothing 
cn.Close 
Set cn = Nothing

來源

2012-02-17 00:33:45 Fionnuala

0

請看以下簡單的代碼

Option Explicit 
Sub Compare() 

Dim Row1Crnt As Long 
Dim Row2Crnt As Long 
Dim Row3Crnt As Long  
Dim Row1Last As Long 
Dim Row2Last As Long  

Dim ValueSheet1 
Dim ValueSheet2 
Dim duplicate As Boolean  
Dim maxColmn As Long 
Dim i 
maxColmn = 10 ' number of column to compare 
For i = 1 To maxColmn 

With Sheets("Sheet1") 
    Row1Last = .Cells(Rows.Count, i).End(xlUp).Row 
End With 

With Sheets("Sheet2") 
    Row2Last = .Cells(Rows.Count, i).End(xlUp).Row 
End With 

Row1Crnt = 2 
Row2Crnt = 2 
Row3Crnt = 2  
maxColmn = 10 

Do While Row2Crnt <= Row2Last 

duplicate = False 
Row1Crnt = 2 

With Sheets("Sheet2") 
    ValueSheet2 = .Cells(Row2Crnt, i).Value 
End With 

Do While Row1Crnt <= Row1Last 

With Sheets("Sheet1") 
    ValueSheet1 = .Cells(Row1Crnt, i).Value 
End With 

If ValueSheet1 = ValueSheet2 Then 
duplicate = True 
Exit Do 

End If 
Row1Crnt = Row1Crnt + 1 
Loop 

If duplicate = False Then 
With Sheets("Sheet3") 
    .Cells(Row3Crnt, i).Value = ValueSheet2 
    Row3Crnt = Row3Crnt + 1 
    End With 

End If 

Row2Crnt = Row2Crnt + 1 
Loop 
Next 

End Sub

來源

2013-10-12 18:35:17

Excel比較在不同的工作表和不匹配/不匹配的結果中的兩個工作表應該存儲在其他方面

回答

相關問題