我正在基于密钥比较2个工作表，并将结果写入新工作簿。 KEY栏是A。
2个工作簿是今天和昨天的文件。
我需要将今天的文件与昨天的文件进行比较。以下是我的情景：
如果两个工作表中的KEY匹配，并且相应KEY的所有列都匹配来自（B：E），那么在F列中，该值应为NO CHANGE
如果两个工作表中的KEY匹配，并且如果任何列与KEY（B：E）对应的列不匹配，则F列应具有值CHANGED
如果KEY不匹配，则F列应具有值NEW RECORD
下面是我的代码编写逻辑覆盖了我的值，他们正在写我昨天的文件而不是今天的文件：
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="com.example.administrator.broadcasttest">
<application
android:allowBackup="true"
android:icon="@mipmap/ic_launcher"
android:label="@string/app_name"
android:supportsRtl="true"
android:theme="@style/AppTheme">
<receiver android:name=".MyBroadcastReceiver">
<intent-filter>
<action android:name="com.example.administrator.broadcasttest.MY_BROADCAST"/>
</intent-filter>
</receiver>
<activity android:name=".MainActivity">
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
</application>
</manifest>
你们可以帮忙纠正这个吗？
答案 0 :(得分：0)
假设所有3张纸都在当前工作簿中，我将一个示例VBA代码（也经过测试）放在一起。您可以进行必要的更改和调整以设置工作簿和工作表。我已经使用Excel公式和2维数组的组合来从Excel读取数据并写回Excel。请记住，当您从Excel读取到二维数组时，数组的下限为1，但是当您回写到Excel时，您需要启动基于0的数组（包括行和列）。
Public Sub CompareSheets()
Dim wb As Workbook, xlRng As Range
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Ar1, Ar2, Ar3, ArLoad()
Dim lstR1!, lstR2!, iRow!, nRow!, str1$, str2$
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1): Set ws2 = wb.Sheets(2): Set ws3 = wb.Sheets(3)
' Get the last non blank cell in Column A in 1st and 2nd worksheets
Set xlRng = ws3.Cells(1, 1)
With xlRng
.FormulaR1C1 = "=MAX((" & ws1.Name & "!C1<>"""")*(ROW(" & ws1.Name & "!C1)))"
.FormulaArray = .Formula: .Calculate: lstR1 = .Value2
.FormulaR1C1 = "=MAX((" & ws2.Name & "!C1<>"""")*(ROW(" & ws2.Name & "!C1)))"
.FormulaArray = .Formula: .Calculate: lstR2 = .Value2
.Clear
End With
' Load into 2-d array data 1st and 2nd sheets
Ar1 = ws1.Range("A1:E" & lstR1).Value
Ar2 = ws2.Range("A1:E" & lstR2).Value
' Load Row number of 1st sheet that matches current row of second sheet
Set xlRng = ws3.Range("A1:A" & lstR2)
With xlRng
.FormulaR1C1 = "=IFERROR(MATCH(" & ws2.Name & "!RC," & ws1.Name & "!C,0),0)"
.Calculate: Ar3 = .Value: .Clear
End With
ReDim Preserve ArLoad(lstR2 - 1, 5) ' this is the array that will be loaded into 3rd worksheet
For iRow = 1 To UBound(Ar3, 1)
For nCol = 1 To 5
ArLoad(iRow - 1, nCol - 1) = Ar2(iRow, nCol) ' Load ArLoad with data from ws2
Next nCol
' Load Last Column of ArLoad with respective value depending if there is a change o
If Ar3(iRow, 1) > 0 Then
nRow = Ar3(iRow, 1) ' matching row number of 1st worksheet
str2 = Ar2(iRow, 2) & Ar2(iRow, 3) & Ar2(iRow, 4) & Ar2(iRow, 5)
str1 = Ar1(nRow, 2) & Ar1(nRow, 3) & Ar1(nRow, 4) & Ar1(nRow, 5)
If str1 = str2 Then
ArLoad(iRow - 1, 5) = "NO CHANGE"
Else
ArLoad(iRow - 1, 5) = "CHANGED"
End If
Else
ArLoad(iRow - 1, 5) = "NEW RECORD"
End If
Next iRow
ws3.Range("A1:F" & lstR2).Value = ArLoad
End Sub
答案 1 :(得分：0)
尝试一下
'ASSUMPTIONS:
'Data begins in cell A1 of each worksheet
'Data is continuous (does not have blank rows or columns)
'Comparison Key should be in column A of each sheet and should NEVER be blank
Sub CompareArrays()
' Sheet1.Cells.ClearContents ' *********** UNKNOWN SHEET
Dim filePick As FileDialog ' set up filePicker object
Set filePick = Application.FileDialog(msoFileDialogFilePicker)
filePick.AllowMultiSelect = False
MsgBox "Select Today's Common Customer File"
filePick.Title = "SELECT BOOK ONE"
filePick.Show
Dim todayBookName As String
todayBookName = filePick.SelectedItems(1)
MsgBox "Select Yesterday's Common Customer File"
filePick.Title = "SELECT BOOK TWO"
filePick.Show
Dim yesterBookName As String
yesterBookName = filePick.SelectedItems(1)
MsgBox "Select Output Common Customer File"
filePick.Title = "SELECT BOOK THREE"
filePick.Show
Dim outputBookName As String
outputBookName = filePick.SelectedItems(1)
Set filePick = Nothing
Dim todayBook As Workbook
todayBook = Application.Workbooks.Open(todayBookName)
Dim yesterBook As Workbook
yesterBook = Application.Workbooks.Open(yesterBookName)
Dim outputBook As Workbook
outputBook = Application.Workbooks.Open(outputBookName)
' -------------------- process workbooks -----------------
Dim recordStatus As String
Dim yesterCell As Range
Dim outputCell As Range
Dim keyToCompare As Variant
Dim i As Integer
Dim todayCell As Range
Set todayCell = todayBook.Sheets("Sheet1").Range("A1") ' set pointer to cell A1
Do While todayCell.Value <> ""
keyToCompare = todayCell.Resize(1, 6).Value ' copy row of cells ... one extra cell at end
keyToCompare = Application.Transpose(keyToCompare) ' convert to
keyToCompare = Application.Transpose(keyToCompare) ' single dimension array
Set yesterCell = yesterBook.Sheets("Sheet1").Range("A1") ' set pointer to cell A1
Do While yesterCell.Value <> "" ' process all non-blank cells
Set outputCell = outputBook.Sheets("Sheet1").Range("A1") ' set pointer to cell A1
If yesterCell.Value = keyToCompare(1) Then
If ( _
(yesterCell.Offset(0, 1).Value = keyToCompare(2)) _
And (yesterCell.Offset(0, 2).Value = keyToCompare(3)) _
And (yesterCell.Offset(0, 3).Value = keyToCompare(4)) _
And (yesterCell.Offset(0, 4).Value = keyToCompare(5))) Then
recordStatus = "No Change"
Else
recordStatus = "Change"
End If
Else
recordStatus = "New Record"
End If
keyToCompare(6) = recordStatus
For i = 1 To 5 ' update 5 cells in output workbook
outputCell.Offset(0, i).Value = keyToCompare(i + 1)
Next i
Set yesterCell = yesterCell.Offset(1, 0) ' move pointer one cell down
Set outputCell = outputCell.Offset(1, 0) ' this is missing from original code
Loop
Set todayCell = todayCell.Offset(1, 0)
Loop
End Sub