將 2 對數據與 Ms Excel VBA 中的循環進行比較

Question

有沒有人可以幫助我，請看一下我附上的圖片。 我想比較來自 2 個不同 excel 文件的 2 對數據， Station （左文件列B ）與Station （右文件列A ）和Time （左文件第 1 行）與Tendancy （右文件列 F ）。 左邊的文件是我即將完成的報告，右邊的文件是參考數據。 如果站點和時間數據匹配，則填充“1” ，否則為空。 數據將從單元格C2開始填充，直到Z32 。 我堅持使用我使用的 FOR 和 IF 循環。 這是一個例子：

1. 單元格 C2將歸檔為“1” bcs 在右側文件的00UTC（單元格 F2）處有站2000001（單元格 A2） 。
2. 單元格 E2將保持空白，因為右側文件中有2000001站但不是02UTC 。
3. 單元格 C3將保持空白，因為右側文件中有2000002站但不在00UTC處。

Dim countSM As Long
Dim countSS As Long
Dim countWM As Long
Dim countWS As Long
Dim resultCol As Long
Dim resultRow As Long

Dim lastSM As Long
Dim lastSS As Long
Dim lastWM As Long
Dim lastWS As Long
Dim lastRCol As Long
Dim lastRRow As Long

lastSM = wb1.Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
lastSS = wb2.Sheets("Worksheet").Cells(Rows.count, 1).End(xlUp).Row
lastWM = wb1.Sheets("Sheet1").Cells(1, Columns.count).End(xlToLeft).Column
lastWS = wb2.Sheets("Worksheet").Cells(Rows.count, 1).End(xlUp).Row
lastRCol = wb1.Sheets("Sheet1").Cells(1, Columns.count).End(xlToLeft).Column
lastRRow = wb1.Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row

For countSM = 2 To lastWM
For countSS = 2 To lastWS
If wb1.Sheets("Sheet1").Cells(countSM, "B") = wb2.Sheets("Worksheet").Cells(countSS, "A") Then
    For countWM = 3 To lastWM
    For countWS = 2 To lastWS
    If wb1.Sheets("Sheet1").Cells(1, countWM) = wb2.Sheets("Worksheet").Cells(countWS, "F") Then
        For resultRow = 2 To lastRRow
        For resultCol = 3 To lastRCol
        wb1.Sheets("Sheet1").Cells(resultRow, resultCol) = "1"
        Next resultCol
        Next resultRow
        Next countSS
    ElseIf wb1.Sheets("Sheet1").Cells(1, countWM) <> wb2.Sheets("Worksheet").Cells(countWS, "F") Then
        wb1.Sheets("Sheet1").Cells(resultRow, resultCol) = ""
        Next countWM
    End If
    Next countSS
ElseIf wb1.Sheets("Sheet1").Cells(countSM, "B") <> wb2.Sheets("Worksheet").Cells(countSS, "A") Then
        wb1.Sheets("Sheet1").Cells(resultRow, resultCol) = ""
        Next countSM
End If

Answer 1

我制作了一個可能對你有用的代碼。 只需計算有多少行獲得了您要檢查的電台和 UTC 值。 如果答案為零，請將單元格留空。 如果不是，則返回 1。

我的代碼是在同一個工作簿上設計的，但它可以很容易地適應 2 個不同的工作簿。

我的假數據集：

我的代碼：

Sub test()
'<------>
'
'
'
'
'YOUR CODE TO OPEN BOTH FILES
'
'
'

'<---->



Dim LeftSheet As Worksheet
Dim RightSheet As Worksheet
Dim MyData As Range 'range to store the data (right file)
Dim LR As Long 'Last row of left file, column Station
Dim LC As Long 'Lastcolumn of left file, (whatever UTC it is)
Dim i As Long
Dim zz As Long
Dim MiF As WorksheetFunction
Set MiF = WorksheetFunction
Dim MyStation As String
Dim MyUTC As String


'Probably you'll need just to adjust references to worksheets from different workbooks

Set LeftSheet = ThisWorkbook.Worksheets("Destiny")
Set RightSheet = ThisWorkbook.Worksheets("Source")

'we store all data into array
Set MyData = RightSheet.Range("A1").CurrentRegion

'data starts at index 2, and we want data from columns 1 and 6 on the range
'Columns 1 and 6 mean columns A and F

'I guess maybe you'll need to adapt this too.
With LeftSheet
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
    'we count how many rows got the station and tendancy value (intersection) on the right file
    ' if the count is 0, do nothing. If not zero, return 1 on the cell
    'our references will be always at column 2 and row 1
    
    For i = 2 To LR Step 1 'we start at row 2 on left file
    
        MyStation = .Range("B" & i).Value
        For zz = 3 To LC Step 1 'we start at column 3, that means column C
            MyUTC = .Cells(1, zz).Value
            If MiF.CountIfs(MyData.Columns(1), MyStation, MyData.Columns(6), MyUTC) <> 0 Then .Cells(i, zz).Value = 1
        Next zz
    Next i

End With


'clean variables
Set MyData = Nothing
Set LeftSheet = Nothing
Set RightSheet = Nothing
End Sub

Output 執行代碼后：

Answer 2

試試這個解決方案：

    Option Explicit

    Private Type TWorksheetData
        WrkSheet As Worksheet
        LastRow As Long
        LastColumn As Long
    End Type

    Sub CopyCompare()
        'Organize the variables by referenced worksheet
        Dim worksheetData As TWorksheetData
        Dim sheet1Data As TWorksheetData
        
        'your solution will provide separate Workbooks for the code below
        'ActiveWorkbook (in my case) had both worksheets in order to develop the solution
        sheet1Data = SetupWorksheetData(Application.ActiveWorkbook, "Sheet1", sheet1Data)
        worksheetData = SetupWorksheetData(Application.ActiveWorkbook, "Worksheet", worksheetData)
        
        Dim refData As Dictionary
        Set refData = New Dictionary
        
        'Load the reference data (key = station, value = collection of UTCs)
        Dim station As Long
        Dim countRow As Long
        For countRow = 2 To worksheetData.LastRow
            station = CLng(worksheetData.WrkSheet.Range("A" & CStr(countRow)).Value)
            If Not refData.Exists(station) Then
                refData.Add station, New Collection
            End If

            refData(station).Add worksheetData.WrkSheet.Range("F" & CStr(countRow)).Value
        Next countRow
        
        'Load the UTC header columns from Sheet1
        Dim outputMap As Dictionary '(key = UTCXX, value = column Number)
        Set outputMap = LoadUTCHeaderColumns(sheet1Data)
        
        'Operate on the Sheet1 data to set the value
        For countRow = 2 To sheet1Data.LastRow
            station = CLng(sheet1Data.WrkSheet.Range("B" & CStr(countRow)).Value)
            Dim utcRef As Variant
            If refData.Exists(station) Then
                Dim utc As Variant
                For Each utc In refData(station)
                    If InputSheetHasUTCEntry(utc, outputMap) Then
                        sheet1Data.WrkSheet.Cells(countRow, outputMap(utc)) = "1"
                    End If
                Next
            End If
        Next countRow
    End Sub

    Private Function InputSheetHasUTCEntry(ByVal utc As String, ByVal outputMap As Dictionary) As Boolean
        InputSheetHasUTCEntry = False
        Dim utcRef As Variant
        For Each utcRef In outputMap.Keys
            If utc = utcRef Then
                InputSheetHasUTCEntry = True
                Exit Function
            End If
        Next utcRef
    End Function

    Private Function LoadUTCHeaderColumns(ByRef sheetData As TWorksheetData) As Dictionary
        Set LoadUTCHeaderColumns = New Dictionary
        Dim columnHeader As String
        Dim outputCol As Long
        For outputCol = 1 To sheetData.LastColumn
            columnHeader = sheetData.WrkSheet.Cells(1, outputCol).Value
            If InStr(columnHeader, "UTC") > 0 Then
                LoadUTCHeaderColumns.Add columnHeader, outputCol
            End If
        Next outputCol
    End Function

    Private Function SetupWorksheetData(ByVal wb As Workbook, ByVal sheetName As String, ByRef wrksheetData As TWorksheetData) As TWorksheetData
        SetupWorksheetData = wrksheetData
        Set SetupWorksheetData.WrkSheet = wb.Sheets(sheetName)
        SetupWorksheetData.LastRow = SetupWorksheetData.WrkSheet.Cells(Rows.Count, 1).End(xlUp).Row
        SetupWorksheetData.LastColumn = SetupWorksheetData.WrkSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    End Function

解決方案評論：

1. 從Worksheet中加載 static 參考數據（建議使用不同的工作表名稱）
2. 從Sheet1加載 static 列號信息
3. 對於使用的每個工作表，有許多變量包含相似的數據。 這表明有機會使用UserDefinedType （在本例中為TWorksheetData ）。 這組織並減少了要聲明和跟蹤的變量的數量。

#1 和 #2 使用字典來保留和關聯 static 信息（需要添加對 Microsoft 腳本運行時的引用）。

其他的建議：

1. （最佳實踐）始終在模塊頂部聲明Option Explicit 。 強制聲明所有變量。
2. （最佳實踐）不要重復自己（DRY） - 原始代碼中有很多重復的表達式。 這對於字符串尤其重要。 使用提供的解決方案可以完成更多工作，但是（例如）您會注意到工作表名稱字符串只出現一次。